1: #!/usr/local/bin/perl -w
3: package SGML::ElementMap::Example::Calculator;
4: use strict;
5: use vars qw($trace $trace_processing);
6: $trace = 0;
7: $trace_processing = 0;
10: sub accum {
11: my ($eng,$val) = @_;
12: #return if $val eq 'void';
13: my $op = $eng->stack->{'op'};
14: if ($op eq 'push') {
15: push @{ $eng->stack->{'val'} }, $val;
16: } elsif ($op eq 'set') {
17: $eng->stack->{'val'} = $val;
18: }
19: }
21: sub Initialize {
22: my ($engine) = @_;
24: #this mode will skip all content
25: $engine->mode_set('NOEVAL');
26: $engine->cdata('',sub { });
27: $engine->element('','suppress');
28:
29: #this mode will skip the first element it encounters, and then pop the mode
30: #so, it should only be entered after a push
31: $engine->mode_set('SKIPNEXT');
32: $engine->cdata('',sub { });
33: $engine->element('',sub {
34: my ($eng,$el) = @_;
35: $eng->suppress_content;
36: $eng->mode_set_pop;
37: });
39: #this mode evaluates normally and does the bulk of the work
40: $engine->mode_set('EVAL');
41:
42: $engine->pi('','suppress');
43: $engine->cdata('',sub { });
44: $engine->cdata('VAR|INT|_SAVE_TEXT/', sub {
45: my ($eng,$obj) = @_;
46: $eng->stack->{'val'} .= $obj->{'Data'};
47: });
48: $engine->element('_SAVE_TEXT',sub {
49: my ($eng,$el) = @_;
50: my ($res) = $eng->process_content_filt('val','');
51: $res =~ s/^\s+//;
52: $res =~ s/\s+$//;
53: accum($eng,$res);
54: });
55:
56: $engine->element('INT',sub {
57: my ($eng,$el) = @_;
58: my ($res) = $eng->process_content_filt('val','','op','set');
59: $res =~ s/^\s+//;
60: $res =~ s/\s+$//;
61: if ($res ne '') {
62: accum($eng,$res);
63: warn "INT:$res\n" if $trace;
64: } else {
65: warn "Empty integer element ignored\n";
66: }
67: });
68:
69: $engine->element('VAR',sub {
70: my ($eng,$el) = @_;
71: my ($res) = $eng->process_content_filt('val','','op','set');
72: $res =~ s/^\s+//;
73: $res =~ s/\s+$//;
74: if ($res ne '') {
75: accum($eng, $eng->stack->{'vars'}->{$res});
76: warn "VAR:$res:".$eng->stack->{'vars'}->{$res}."\n" if $trace;
77: } else {
78: warn "Empty variable element ignored\n";
79: }
80: });
81:
82:
83: $engine->element('ADD',sub {
84: my ($eng,$el) = @_;
85: my (@args,$res);
86: $eng->process_content_filt('val',\@args,'op','push');
87: $res = 0;
88: foreach (@args) { $res += $_; }
89: accum($eng,$res);
90: warn "ADD:$res\n" if $trace;
91: });
92:
93: $engine->element('MULT',sub {
94: my ($eng,$el) = @_;
95: my (@args,$res);
96: @args = ();
97: $eng->process_content_filt('val',\@args,'op','push');
98: $res = 1;
99: foreach (@args) {
100: $res *= $_;
101: }
102: accum($eng,$res);
103: warn "MULT:$res\n" if $trace;
104: });
106: $engine->element('EQUAL',sub {
107: my ($eng,$el) = @_;
108: my (@args,$res,$arg);
109: $eng->process_content_filt('val',\@args,'op','push');
110: $arg = shift @args;
111: $res = 1;
112: foreach (@args) {
113: $res = 0 if ($_ != $arg);
114: }
115: accum($eng,$res);
116: warn "EQUAL:$res\n" if $trace;
117: });
118:
119: $engine->element('SCOPE',sub {
120: my ($eng,$el) = @_;
121: my $state = $eng->stack->opaque;
122: $eng->stack->{'val'} = '';
123: $eng->stack->{'op'} = 'set';
124: $eng->stack->set_layer($state);
125: $eng->insert_pseudo_element('_SAVE_TEXT');
126: my $cmd = $eng->stack->{'val'};
127:
128: my $vardata = $eng->stack->{'vars'};
129: if ($cmd eq 'push') {
130: $vardata->push;
131: } elsif ($cmd eq 'pop') {
132: $vardata->pop;
133: } elsif ($cmd =~ /^(\w+)\s+default$/) {
134: $vardata->set_default($1);
135: } else {
136: $vardata->set_layer($cmd);
137: }
138: warn "SCOPE:".$vardata->id.":$cmd\n" if $trace;
139: });
140:
141: $engine->element('SET',sub {
142: my ($eng,$el) = @_;
143: my ($name,$res) = $eng->process_content_filt('name','','val','void',
144: 'op','set');
145: $eng->stack->{'vars'}->{$name} = $res;
146: accum($eng,$res);
147: warn "SET:$name:$res\n" if $trace;
148: });
149:
150: $engine->element('SET/VAR',sub {
151: my ($eng,$el) = @_;
152: my ($res) = $eng->process_content_filt('val','');
153: $res =~ s/^\s+//;
154: $res =~ s/\s+$//;
155: $eng->stack->{'name'} = $res;
156: warn "VAR:$res\n" if $trace;
157: });
158:
159: $engine->element('BLOCK',sub {
160: my ($eng,$el) = @_;
161: my ($res) = $eng->process_content_filt('val','void','op','set');
162: accum($eng,$res);
163: warn "BLOCK:$res\n" if $trace;
164: });
165: $engine->element('SHOW',sub {
166: my ($eng,$el) = @_;
167: my ($res) = $eng->process_content_filt('val','void','op','set');
168: print $res . "\n";
169: accum($eng,$res);
170: warn "SHOW:$res\n" if $trace;
171: });
172:
173: $engine->element('MSG',sub {
174: my ($eng,$el) = @_;
175: my $state = $eng->stack->opaque;
176: $eng->stack->{'val'} = '';
177: $eng->stack->{'op'} = 'set';
178: $eng->stack->set_layer($state);
179: $eng->insert_pseudo_element('_SAVE_TEXT');
180: my $msg = $eng->stack->{'val'};
181: print $msg . "\n";
182: warn "MSG:$msg\n" if $trace;
183: });
184:
185: $engine->element('COM','suppress');
187: $engine->element('COND',sub {
188: my ($eng,$el) = @_;
189: $eng->mode_set_push('COND');
190: my ($res) = $eng->process_content_filt('val','void','op','set',
191: 'cond','undef');
192: $eng->mode_set_pop;
193: accum($eng,$res);
194: warn "COND:$res\n" if $trace;
195: });
196:
197: #this mode is used because default handlers are searched only after
198: #no other handlers match, but each mode is searched completely in turn
199: #That is, you need modes for a default handler to override a non-default
200: $engine->mode_set('COND');
202: $engine->element('COND/',sub { #default for direct COND subels
203: my ($eng,$el) = @_;
204: my $state = $eng->stack->{'cond'};
205: if ($state eq 'true') {
206: $eng->reprocess_pseudo_element('_COND_EVAL');
207: $eng->mode_set('NOEVAL'); #replaces COND
208: } elsif ($state eq 'false') {
209: $eng->suppress_content;
210: $eng->stack->{'cond'} = 'undef';
211: } elsif ($state eq 'undef') {
212: $eng->reprocess_pseudo_element('_COND_TEST');
213: } else {
214: die "unknown COND state '".$state."'\n";
215: }
216: });
217:
218: $engine->element('COND/_COND_EVAL',sub {
219: my ($eng,$el) = @_;
220: my @modes = $eng->mode_set_pop;
221: $eng->process_content;
222: $eng->mode_set_push(@modes);
223: });
224:
225: $engine->element('COND/_COND_TEST',sub {
226: my ($eng,$el) = @_;
227: my @modes = $eng->mode_set_pop;
228: my ($res) = $eng->process_content_filt('val','void','op','set');
229: $eng->mode_set_push(@modes);
230: if ($res ne 'void' && $res != 0) {
231: $eng->stack->{'cond'} = 'true';
232: } else {
233: $eng->stack->{'cond'} = 'false';
234: }
235: warn "COND:TEST:".$eng->stack->{'cond'}."\n" if $trace;
236: });
237:
238: $engine->element('COND/ELSE',sub {
239: my ($eng,$el) = @_;
240: my @modes = $eng->mode_set_pop;
241: $eng->process_content;
242: $eng->mode_set_push(@modes);
243: $eng->mode_set('NOEVAL'); #replaces COND
244: warn "COND:ELSE\n" if $trace;
245: });
248: $engine->mode_set('EVAL');
249: $engine->stack->default_cascade;
250: $engine->stack->{'op'} = 'nop';
251: $engine->stack->{'vars'} = new Hash::Layered;
252: if ($trace) {
253: select STDERR; $| = 1;
254: select STDOUT; $| = 1;
255: }
256: $engine->debug('general','element_path','handler_lookup','modes',
257: 'visitors') if $trace_processing;
258: $engine->stack->{'vars'}->trace if ($trace > 3);
260: return 1;
261: }
264: 1;