line
stmt
bran
cond
sub
pod
time
code
1
####################################################################
2
#
3
# This file was generated using Parse::Yapp version 1.05.
4
#
5
# Don't edit this file, use source file instead.
6
#
7
# ANY CHANGE MADE HERE WILL BE LOST !
8
#
9
####################################################################
10
package PerlPoint::Parser;
11
34
34
241814
use vars qw ( @ISA );
34
84
34
2503
12
34
34
262
use strict;
34
81
34
7231
13
14
@ISA= qw ( Parse::Yapp::Driver );
15
#Included Parse/Yapp/Driver.pm file----------------------------------------
16
{
17
#
18
# Module Parse::Yapp::Driver
19
#
20
# This module is part of the Parse::Yapp package available on your
21
# nearest CPAN
22
#
23
# Any use of this module in a standalone parser make the included
24
# text under the same copyright as the Parse::Yapp module itself.
25
#
26
# This notice should remain unchanged.
27
#
28
# (c) Copyright 1998-2001 Francois Desarmenien, all rights reserved.
29
# (see the pod text in Parse::Yapp module for use and distribution rights)
30
#
31
32
package Parse::Yapp::Driver;
33
34
require 5.004;
35
36
34
34
199
use strict;
34
71
34
1067
37
38
34
34
168
use vars qw ( $VERSION $COMPATIBLE $FILENAME );
34
76
34
2697
39
40
$VERSION = '1.05';
41
$COMPATIBLE = '0.07';
42
$FILENAME=__FILE__;
43
44
34
34
207
use Carp;
34
112
34
41557
45
46
#Known parameters, all starting with YY (leading YY will be discarded)
47
my(%params)=(YYLEX => 'CODE', 'YYERROR' => 'CODE', YYVERSION => '',
48
YYRULES => 'ARRAY', YYSTATES => 'ARRAY', YYDEBUG => '');
49
#Mandatory parameters
50
my(@params)=('LEX','RULES','STATES');
51
52
sub new {
53
35
35
151
my($class)=shift;
54
35
86
my($errst,$nberr,$token,$value,$check,$dotpos);
55
35
539
my($self)={ ERROR => \&_Error,
56
ERRST => \$errst,
57
NBERR => \$nberr,
58
TOKEN => \$token,
59
VALUE => \$value,
60
DOTPOS => \$dotpos,
61
STACK => [],
62
DEBUG => 0,
63
CHECK => \$check };
64
65
35
252
_CheckParams( [], \%params, \@_, $self );
66
67
35
50
33
557
exists($$self{VERSION})
68
and $$self{VERSION} < $COMPATIBLE
69
and croak "Yapp driver version $VERSION ".
70
"incompatible with version $$self{VERSION}:\n".
71
"Please recompile parser module.";
72
73
35
50
181
ref($class)
74
and $class=ref($class);
75
76
35
246
bless($self,$class);
77
}
78
79
sub YYParse {
80
37
37
258
my($self)=shift;
81
37
998
my($retval);
82
83
37
853
_CheckParams( \@params, \%params, \@_, $self );
84
85
37
50
240
if($$self{DEBUG}) {
86
0
0
_DBLoad();
87
0
0
$retval = eval '$self->_DBParse()';#Do not create stab entry on compile
88
0
0
0
$@ and die $@;
89
}
90
else {
91
37
933
$retval = $self->_Parse();
92
}
93
37
401
$retval
94
}
95
96
sub YYData {
97
0
0
0
my($self)=shift;
98
99
0
0
0
exists($$self{USER})
100
or $$self{USER}={};
101
102
0
0
$$self{USER};
103
104
}
105
106
sub YYErrok {
107
0
0
0
my($self)=shift;
108
109
0
0
${$$self{ERRST}}=0;
0
0
110
0
0
undef;
111
}
112
113
sub YYNberr {
114
0
0
0
my($self)=shift;
115
116
0
0
${$$self{NBERR}};
0
0
117
}
118
119
sub YYRecovering {
120
0
0
0
my($self)=shift;
121
122
0
0
${$$self{ERRST}} != 0;
0
0
123
}
124
125
sub YYAbort {
126
0
0
0
my($self)=shift;
127
128
0
0
${$$self{CHECK}}='ABORT';
0
0
129
0
0
undef;
130
}
131
132
sub YYAccept {
133
33
33
115
my($self)=shift;
134
135
33
207
${$$self{CHECK}}='ACCEPT';
33
701
136
33
94
undef;
137
}
138
139
sub YYError {
140
0
0
0
my($self)=shift;
141
142
0
0
${$$self{CHECK}}='ERROR';
0
0
143
0
0
undef;
144
}
145
146
sub YYSemval {
147
0
0
0
my($self)=shift;
148
0
0
my($index)= $_[0] - ${$$self{DOTPOS}} - 1;
0
0
149
150
0
0
$index < 0
151
0
0
0
0
and -$index <= @{$$self{STACK}}
152
and return $$self{STACK}[$index][1];
153
154
0
0
undef; #Invalid index
155
}
156
157
sub YYCurtok {
158
8
8
13
my($self)=shift;
159
160
@_
161
8
100
22
and ${$$self{TOKEN}}=$_[0];
4
9
162
8
9
${$$self{TOKEN}};
8
34
163
}
164
165
sub YYCurval {
166
28
28
49
my($self)=shift;
167
168
@_
169
28
100
70
and ${$$self{VALUE}}=$_[0];
4
10
170
28
36
${$$self{VALUE}};
28
244
171
}
172
173
sub YYExpect {
174
4
4
12
my($self)=shift;
175
176
4
8
keys %{$self->{STATES}[$self->{STACK}[-1][0]]{ACTIONS}}
4
247
177
}
178
179
sub YYLexer {
180
0
0
0
my($self)=shift;
181
182
0
0
$$self{LEX};
183
}
184
185
186
#################
187
# Private stuff #
188
#################
189
190
191
sub _CheckParams {
192
72
72
250
my($mandatory,$checklist,$inarray,$outhash)=@_;
193
72
168
my($prm,$value);
194
72
210
my($prmlst)={};
195
196
72
701
while(($prm,$value)=splice(@$inarray,0,2)) {
197
216
514
$prm=uc($prm);
198
216
50
937
exists($$checklist{$prm})
199
or croak("Unknow parameter '$prm'");
200
216
50
813
ref($value) eq $$checklist{$prm}
201
or croak("Invalid value for parameter '$prm'");
202
216
1014
$prm=unpack('@2A*',$prm);
203
216
1741
$$outhash{$prm}=$value;
204
}
205
72
412
for (@$mandatory) {
206
111
50
704
exists($$outhash{$_})
207
or croak("Missing mandatory parameter '".lc($_)."'");
208
}
209
}
210
211
sub _Error {
212
0
0
0
print "Parse error.\n";
213
}
214
215
sub _DBLoad {
216
{
217
34
34
252
no strict 'refs';
34
0
87
34
151352
0
0
218
219
0
0
0
exists(${__PACKAGE__.'::'}{_DBParse})#Already loaded ?
0
0
220
and return;
221
}
222
0
0
my($fname)=__FILE__;
223
0
0
my(@drv);
224
0
0
0
open(DRV,"<$fname") or die "Report this as a BUG: Cannot open $fname";
225
0
0
while() {
226
/^\s*sub\s+_Parse\s*{\s*$/ .. /^\s*}\s*#\s*_Parse\s*$/
227
0
0
0
and do {
228
0
0
s/^#DBG>//;
229
0
0
push(@drv,$_);
230
}
231
}
232
0
0
close(DRV);
233
234
0
0
$drv[0]=~s/_P/_DBP/;
235
0
0
eval join('',@drv);
236
}
237
238
#Note that for loading debugging version of the driver,
239
#this file will be parsed from 'sub _Parse' up to '}#_Parse' inclusive.
240
#So, DO NOT remove comment at end of sub !!!
241
sub _Parse {
242
37
37
6580
my($self)=shift;
243
244
37
498
my($rules,$states,$lex,$error)
245
= @$self{ 'RULES', 'STATES', 'LEX', 'ERROR' };
246
37
336
my($errstatus,$nberror,$token,$value,$stack,$check,$dotpos)
247
= @$self{ 'ERRST', 'NBERR', 'TOKEN', 'VALUE', 'STACK', 'CHECK', 'DOTPOS' };
248
249
#DBG> my($debug)=$$self{DEBUG};
250
#DBG> my($dbgerror)=0;
251
252
#DBG> my($ShowCurToken) = sub {
253
#DBG> my($tok)='>';
254
#DBG> for (split('',$$token)) {
255
#DBG> $tok.= (ord($_) < 32 or ord($_) > 126)
256
#DBG> ? sprintf('<%02X>',ord($_))
257
#DBG> : $_;
258
#DBG> }
259
#DBG> $tok.='<';
260
#DBG> };
261
262
37
115
$$errstatus=0;
263
37
93
$$nberror=0;
264
37
136
($$token,$$value)=(undef,undef);
265
37
381
@$stack=( [ 0, undef ] );
266
37
212
$$check='';
267
268
37
112
while(1) {
269
27940
48971
my($actions,$act,$stateno);
270
271
27940
47748
$stateno=$$stack[-1][0];
272
27940
42143
$actions=$$states[$stateno];
273
274
#DBG> print STDERR ('-' x 40),"\n";
275
#DBG> $debug & 0x2
276
#DBG> and print STDERR "In state $stateno:\n";
277
#DBG> $debug & 0x08
278
#DBG> and print STDERR "Stack:[".
279
#DBG> join(',',map { $$_[0] } @$stack).
280
#DBG> "]\n";
281
282
283
27940
100
66319
if (exists($$actions{ACTIONS})) {
284
285
defined($$token)
286
7108
100
24135
or do {
287
5882
30397
($$token,$$value)=&$lex($self);
288
#DBG> $debug & 0x01
289
#DBG> and print STDERR "Need token. Got ".&$ShowCurToken."\n";
290
};
291
292
7108
100
49069
$act= exists($$actions{ACTIONS}{$$token})
100
293
? $$actions{ACTIONS}{$$token}
294
: exists($$actions{DEFAULT})
295
? $$actions{DEFAULT}
296
: undef;
297
}
298
else {
299
20832
67655
$act=$$actions{DEFAULT};
300
#DBG> $debug & 0x01
301
#DBG> and print STDERR "Don't need token.\n";
302
}
303
304
defined($act)
305
27940
100
66730
and do {
306
307
$act > 0
308
27936
100
66487
and do { #shift
309
310
#DBG> $debug & 0x04
311
#DBG> and print STDERR "Shift and go to state $act.\n";
312
313
$$errstatus
314
5878
50
12826
and do {
315
0
0
--$$errstatus;
316
317
#DBG> $debug & 0x10
318
#DBG> and $dbgerror
319
#DBG> and $$errstatus == 0
320
#DBG> and do {
321
#DBG> print STDERR "**End of Error recovery.\n";
322
#DBG> $dbgerror=0;
323
#DBG> };
324
};
325
326
327
5878
14141
push(@$stack,[ $act, $$value ]);
328
329
5878
100
18071
$$token ne '' #Don't eat the eof
330
and $$token=$$value=undef;
331
5878
9334
next;
332
};
333
334
#reduce
335
22058
28720
my($lhs,$len,$code,@sempar,$semval);
336
22058
25786
($lhs,$len,$code)=@{$$rules[-$act]};
22058
68928
337
338
#DBG> $debug & 0x04
339
#DBG> and $act
340
#DBG> and print STDERR "Reduce using rule ".-$act." ($lhs,$len): ";
341
342
22058
100
64963
$act
343
or $self->YYAccept();
344
345
22058
28630
$$dotpos=$len;
346
347
unpack('A1',$lhs) eq '@' #In line rule
348
22058
100
95224
and do {
349
1884
50
10398
$lhs =~ /^\@[0-9]+\-([0-9]+)$/
350
or die "In line rule name '$lhs' ill formed: ".
351
"report it as a BUG.\n";
352
1884
4239
$$dotpos = $1;
353
};
354
355
30567
85523
@sempar = $$dotpos
356
22058
100
92002
? map { $$_[1] } @$stack[ -$$dotpos .. -1 ]
357
: ();
358
359
22058
100
81848
$semval = $code ? &$code( $self, @sempar )
100
360
: @sempar ? $sempar[0] : undef;
361
362
22058
56718
splice(@$stack,-$len,$len);
363
364
$$check eq 'ACCEPT'
365
22058
100
76558
and do {
366
367
#DBG> $debug & 0x04
368
#DBG> and print STDERR "Accept.\n";
369
370
33
309
return($semval);
371
};
372
373
$$check eq 'ABORT'
374
22025
50
81225
and do {
375
376
#DBG> $debug & 0x04
377
#DBG> and print STDERR "Abort.\n";
378
379
0
0
return(undef);
380
381
};
382
383
#DBG> $debug & 0x04
384
#DBG> and print STDERR "Back to state $$stack[-1][0], then ";
385
386
$$check eq 'ERROR'
387
22025
50
86602
or do {
388
#DBG> $debug & 0x04
389
#DBG> and print STDERR
390
#DBG> "go to state $$states[$$stack[-1][0]]{GOTOS}{$lhs}.\n";
391
392
#DBG> $debug & 0x10
393
#DBG> and $dbgerror
394
#DBG> and $$errstatus == 0
395
#DBG> and do {
396
#DBG> print STDERR "**End of Error recovery.\n";
397
#DBG> $dbgerror=0;
398
#DBG> };
399
400
22025
86899
push(@$stack,
401
[ $$states[$$stack[-1][0]]{GOTOS}{$lhs}, $semval ]);
402
22025
38287
$$check='';
403
22025
59965
next;
404
};
405
406
#DBG> $debug & 0x04
407
#DBG> and print STDERR "Forced Error recovery.\n";
408
409
0
0
$$check='';
410
411
};
412
413
#Error
414
$$errstatus
415
4
50
21
or do {
416
417
4
14
$$errstatus = 1;
418
4
25
&$error($self);
419
4
50
25
$$errstatus # if 0, then YYErrok has been called
420
or next; # so continue parsing
421
422
#DBG> $debug & 0x10
423
#DBG> and do {
424
#DBG> print STDERR "**Entering Error recovery.\n";
425
#DBG> ++$dbgerror;
426
#DBG> };
427
428
4
12
++$$nberror;
429
430
};
431
432
$$errstatus == 3 #The next token is not valid: discard it
433
4
50
18
and do {
434
$$token eq '' # End of input: no hope
435
0
0
0
and do {
436
#DBG> $debug & 0x10
437
#DBG> and print STDERR "**At eof: aborting.\n";
438
0
0
return(undef);
439
};
440
441
#DBG> $debug & 0x10
442
#DBG> and print STDERR "**Dicard invalid token ".&$ShowCurToken.".\n";
443
444
0
0
$$token=$$value=undef;
445
};
446
447
4
11
$$errstatus=3;
448
449
4
33
103
while( @$stack
66
450
and ( not exists($$states[$$stack[-1][0]]{ACTIONS})
451
or not exists($$states[$$stack[-1][0]]{ACTIONS}{error})
452
or $$states[$$stack[-1][0]]{ACTIONS}{error} <= 0)) {
453
454
#DBG> $debug & 0x10
455
#DBG> and print STDERR "**Pop state $$stack[-1][0].\n";
456
457
16
125
pop(@$stack);
458
}
459
460
@$stack
461
4
50
20
or do {
462
463
#DBG> $debug & 0x10
464
#DBG> and print STDERR "**No state left on stack: aborting.\n";
465
466
4
39
return(undef);
467
};
468
469
#shift the error token
470
471
#DBG> $debug & 0x10
472
#DBG> and print STDERR "**Shift \$error token and go to state ".
473
#DBG> $$states[$$stack[-1][0]]{ACTIONS}{error}.
474
#DBG> ".\n";
475
476
0
push(@$stack, [ $$states[$$stack[-1][0]]{ACTIONS}{error}, undef ]);
477
478
}
479
480
#never reached
481
0
croak("Error in driver logic. Please, report it as a BUG");
482
483
}#_Parse
484
#DO NOT remove comment
485
486
1;
487
488
}
489
#End of include--------------------------------------------------
490
491
492
#line 10 "ppParser.yp"
493
494
495
# = HISTORY SECTION =====================================================================
496
497
# ---------------------------------------------------------------------------------------
498
# version | date | author | changes
499
# ---------------------------------------------------------------------------------------
500
# 0.452 |10.10.2007| JSTENZEL | just for the release;
501
# 0.451 |06.10.2007| JSTENZEL | just for the release;
502
# 0.45 |03.12.2006| JSTENZEL | just for the release;
503
# 0.44 |15.06.2006| JSTENZEL | new type "parsedexample" for \INCLUDE;
504
# |06.08.2006| JSTENZEL | bugfix in parameter check of _evalTagCondition(): using
505
# | | | "if defined $par" instead of "if $par";
506
# |27.11.2006| JSTENZEL | better definition of flagSet() etc., old implementation
507
# | | | was buggy;
508
# 0.43 |09.04.2006| JSTENZEL | slight code optimizations in file embedding;
509
# | | JSTENZEL | INCLUDE now has an "import" option with module API;
510
# | | JSTENZEL | included file type and embedded language now have
511
# | | | default "pp";
512
# | | JSTENZEL | run(): new configuration parameter "importMapping";
513
# 0.42 |05.03.2006| JSTENZEL | non kernel tags now can be configured to be standalone,
514
# | | | in which case a wrapping paragraph is removed from the
515
# | | | stream (IMAGE and LOCALTOC configuration moved to tag
516
# | | | definition);
517
# | | | area, the wrapping paragraph is removed;
518
# |07.03.2006| JSTENZEL | dummy tokens inserted by the parser now are special
519
# | | | strings that can be filtered out by the backend module;
520
# |10.03.2006| JSTENZEL | bugfix: statistics for list shifters did not work;
521
# | | JSTENZEL | Macro default parameters were not documented! Added.
522
# 0.41 |15.12.2005| JSTENZEL | almost all routines are internal, to avoid Pod::Coverage
523
# | | | complaints they now begin with an underscore;
524
# 0.40 |12.06.2003| JSTENZEL | bugfix: delayed tokens were not reparsed when reinserted,
525
# | | | this could cause trouble when the paragraph (special
526
# | | | characters) context changed between the point the
527
# | | | token was detected first and delayed, and the point
528
# | | | the token is reinserted into the stream (especially
529
# | | | important after file inclusion, when the stacked token
530
# | | | is a newline, has to be evaluated in STATE_DEFAULT
531
# | | | but was stacked in a paragraph where newlines are not
532
# | | | ignored;
533
# | | JSTENZEL | additionally, "empty paragraphs" (*skipped* paragraphs)
534
# | | | now are not only *really* empty paragraphs but all
535
# | | | paragraphs containing of whitespaces only;
536
# |21.06.2003| JSTENZEL | headlines provide additional data: their numerical, full
537
# | | | and shortcut pathes;
538
# |22.06.2003| JSTENZEL | _normalizeTableRows() now supplies number of columns both
539
# | | | in title row and the maximum value;
540
# | | JSTENZEL | new warning if the maximum columns number is detected
541
# | | | in another line than the first table line (which is the
542
# | | | base of normalization);
543
# |10.08.2003| JSTENZEL | new helper function _semerr() to report semantic errors;
544
# | | JSTENZEL | new option -criticalSemanticErrors;
545
# |14.08.2003| JSTENZEL | input filters can access the source file by a variable
546
# | | | $main::_ifilterFile now;
547
# | | JSTENZEL | fixed an "undefined value" warning;
548
# |17.08.2003| JSTENZEL | bugfix: docstream "main" was ignored like any other docstream
549
# | | | if working in the "docstream ignore" mode;
550
# |10.09.2003| JSTENZEL | definition list explanations ("texts" now have an own
551
# | | | enveloping directive (DIRECTIVE_DPOINT_TEXT);
552
# |11.09.2003| JSTENZEL | LOCALTOC added to the list of standalone tags (which are
553
# | | | stripped of of an enveloping text paragraph if they are its
554
# | | | only contents);
555
# |05.05.2004| JSTENZEL | anchors now take the number of the page they are defined in;
556
# | | JSTENZEL | tag hooks now take an additional parameter: the number of
557
# | | | the page the tag is used on;
558
# | | JSTENZEL | bugfix: numerical pathes were built incorrectly: when entering
559
# | | | a new sublevel, the counter was not reset to 1;
560
# | | JSTENZEL | added anchors();
561
# |11.07.2004| JSTENZEL | headlines now provide a path of absolute page numbers as well
562
# | | | and a variable snapshot;
563
# | | JSTENZEL | a reset variable is removed now (as a side effect, it is no
564
# | | | longer possible to build variables containing spaces only);
565
# |24.07.2004| JSTENZEL | added -skipcomments;
566
# |10.09.2004| JSTENZEL | bugfix: words looking like symbolic variables (but not defined
567
# | | | as such) were restored without their braces ("{}");
568
# |27.12.2004| JSTENZEL | bugfix: skipped headline levels were filled with previous
569
# | | | headline strings of those levels;
570
# |28.12.2004| JSTENZEL | text paragraphs now have their own special character, but
571
# | | | optional: a dot;
572
# |24.02.2005| JSTENZEL | acceleration: the lexer built some data very often;
573
# |27.02.2005| JSTENZEL | bugfix: backslashes before variables were handled incorrectly,
574
# | | | now variables are no longer "boosted" but handled like macros
575
# | | | - which has a performance drawback, unfortunately ...;
576
# |16.05.2005| JSTENZEL | backslashes in tag options are no longer ignored but can be
577
# | | | used to guard characters;
578
# |23.08.2005| JSTENZEL | first chapter is checked for a headline now;
579
# 0.39 |01.02.2003| JSTENZEL | passing directive id chain of the current chapter
580
# | | | headline to tag hook functions now;
581
# |07.03.2003| JSTENZEL | several variable patterns were used explicitly instead
582
# | | | if the precompiled ones from %lexerPatterns;
583
# | | JSTENZEL | bugfix: guarded variables were expanded;
584
# | | JSTENZEL | now it is documented that list indentation is reset
585
# | | | automatically by a subsequent non list paragraph;
586
# |26.04.2003| JSTENZEL | added "no utf8" to avoid errors under perl 5.8;
587
# |01.05.2003| JSTENZEL | adding *all* composite anchors for headlines, not only
588
# | | | for the full path;
589
# 0.38 |07.06.2002| JSTENZEL | restoring doubled backslashes in filtered paragraphs,
590
# | | | restoring ">" characters as if they were guarded;
591
# |04.07.2002| JSTENZEL | simplified several array field access codes;
592
# | | JSTENZEL | bugfix: empty headlines caused an infinite loop
593
# | | | when trailing whitespaces should be removed;
594
# | | JSTENZEL | bugfix: empty headlines caused a failure when headline
595
# | | | anchors should be stored, skipping them now;
596
# |20.08.2002| JSTENZEL | improved tag streaming: stream now contains a body hint;
597
# | | JSTENZEL | bugfix: paragraph filters restored tag bodies even if
598
# | | | there was no body;
599
# | | JSTENZEL | old caches need to be updated - adapted compatibility hint;
600
# |27.08.2002| JSTENZEL | started to use precompiled lexer patterns;
601
# |31.08.2002| JSTENZEL | \INCLUDE, \EMBED and \TABLE now support the _cnd_ option,
602
# | | | like tags defined externally;
603
# |04.12.2002| JSTENZEL | bugfix in pfilter retranslation: backslash reinsertion was
604
# | | | not performed multiply;
605
# | | JSTENZEL | pfilter retranslation: backslash reinsertion now suppressed
606
# | | | in verbatim blocks;
607
# |01.01.2003| JSTENZEL | added input filter support to \EMBED, via option "ifilter";
608
# |02.01.2003| JSTENZEL | added input filter support to \INCLUDE, same interface;
609
# 0.37 |up to | JSTENZEL | flagSet() now takes a list of flag names;
610
# |14.04.2002| JSTENZEL | names of included files are resolved to avoid trouble
611
# | | | with links (and to avoid error messages);
612
# | | JSTENZEL | \INCLUDE searches pathes specified in environment
613
# | | | variable PERLPOINTLIB (like perl, shells, linkers etc.);
614
# | | JSTENZEL | if tags with finish hooks are used, a paragraph will
615
# | | | not be cached because it becomes potentially dynamic;
616
# | | JSTENZEL | anchors defined by a cached paragraph are cached now
617
# | | | as well - and restored after a cache hit (updated cache
618
# | | | format);
619
# | | JSTENZEL | \INCLUDE additionally searches pathes specified in an
620
# | | | array passed to method run() via new parameter "libpath";
621
# | | JSTENZEL | Filtered paragraphs that need a parser lookahead into
622
# | | | the next paragraph to be completely detected could cause
623
# | | | trouble because the reinserted result was grammatically
624
# | | | placed before the already parsed start token of the
625
# | | | subsequent paragraph. Fixed by introducing a virtual,
626
# | | | empty "Word" token supplied by the lexer in such cases
627
# | | | (look for $flags{virtualParagraphStart} and
628
# | | | $lexerFlags{cbell}). (By the way, this outdated an
629
# | | | earlier solution using a virtual text paragraph startup
630
# | | | and a delayed token - this former solution caused trouble
631
# | | | when the paragraph following the filtered one was not
632
# | | | a pure text (so even filtered texts did not work)).
633
# | | JSTENZEL | Filtered paragraphs are no longer cached - the filter
634
# | | | makes them dynamical. Note that for combined paragraphs
635
# | | | like compound blocks and lists this is true for the first
636
# | | | part only, because subsequent parts can be cached in
637
# | | | their original form (the filter will be applied when the
638
# | | | parts will have been combined).
639
# | | JSTENZEL | paragraph filters: added retranslation of headlines and
640
# | | | verbatim blocks;
641
# | | JSTENZEL | passing original paragraph type to filters by new variable
642
# | | | $main::_pfilterType;
643
# | | JSTENZEL | generalized paragraph type constant to string translation;
644
# | | JSTENZEL | lexer delays to flag the end of the document source
645
# | | | when a paragraph filter still needs to be applied
646
# | | | (otherwise, the parser would not request more tokens
647
# | | | because from his point of view the source was already
648
# | | | parsed completely, so the filtering result (and the
649
# | | | original block) would disappear from the result - it would
650
# | | | not be reparsed);
651
# | | JSTENZEL | empty text paragraphs are no longer made part of the stream;
652
# | | JSTENZEL | blocks were streamed with a final newline, improved;
653
# | | JSTENZEL | added headline shortcuts;
654
# | | JSTENZEL | added document stream entry points;
655
# |15.04.2002| JSTENZEL | added chapter docstream hints to headline stream data;
656
# 0.36 |10.08.2001| JSTENZEL | the stream became a more complex data structure to
657
# | | | allow converter authors to act according to a documents
658
# | | | structure (getting headlines without having to process
659
# | | | all tokens, moving between chapters) - basically, it
660
# | | | *remained* a stream (with additional structure info);
661
# |29.09.2001| JSTENZEL | adapted stream initialization to intermediately
662
# | | | modified design;
663
# | | JSTENZEL | bugfixes in _normalizeTableRows(): standalone single "0"
664
# | | | in table cells was removed;
665
# |07.10.2001| JSTENZEL | improved error messages provide an error pointer;
666
# |11.10.2001| JSTENZEL | removed unused "use fields" directive;
667
# | | JSTENZEL | storing headline anchors now, depending on new
668
# | | | flag headlineLinks;
669
# | | JSTENZEL | modified tag hook interface, tag body array is now
670
# | | | passed by *reference*;
671
# | | JSTENZEL | passing anchor object to tag hooks;
672
# |12.10.2001| JSTENZEL | added tag finish hook interface;
673
# |13.10.2001| JSTENZEL | list shifts are no longer flagged by DIRECTIVE_START
674
# | | | *and* DIRECTIVE_COMPLETED, no just by DIRECTIVE_START;
675
# | | JSTENZEL | headline start directives in the stream now provide
676
# | | | the full (plain) headline;
677
# | | JSTENZEL | added tag conditions;
678
# |14.10.2001| JSTENZEL | bugfix: passed tag options to parsing hooks instead
679
# | | | of tag body;
680
# | | JSTENZEL | using new stream directive index constants;
681
# | | JSTENZEL | stream directives now begin with a hash reference to
682
# | | | pass backend hints;
683
# |17.10.2001| JSTENZEL | new directive format results in modified cache format,
684
# | | | adapted automatic update;
685
# |27.10.2001| JSTENZEL | list directives now contain hints about predecessing
686
# | | | or following list shifts;
687
# |29.10.2001| JSTENZEL | added paragraph filters (in a first version for verb. blocks);
688
# |16.11.2001| JSTENZEL | improved _Error();
689
# | | JSTENZEL | improved lexer traces (did hide lines in verb. blocks and
690
# | | | comments;
691
# | | JSTENZEL | Heredoc close sequence detection is no longer restricted
692
# | | | to original source lines but also active for lines gotten
693
# | | | from stack - this became possible because verbatim block
694
# | | | lines are scanned in *completely* since version 0.34.
695
# | | | As a result, it is possible now to generate verbatim
696
# | | | blocks via active contents, but it is still impossible
697
# | | | to do this for blocks and text paragraphs beginning with
698
# | | | a tag or macro.
699
# |17.11.2001| JSTENZEL | implemented a more general paragraph filter approach
700
# | | | (still incomplete: needs to be extended for lists, needs
701
# | | | retranslation of paragraph stream into text);
702
# |18.11.2001| JSTENZEL | slightly improved _stackInput() (initially empty lines
703
# | | | buffers would have been stacked, and a final buffer value
704
# | | | of "0" would have been ignored);
705
# | | JSTENZEL | detection of block starts and text paragraphs beginning
706
# | | | with a line now take stacked lines into consideration
707
# | | | - this was suppressed because stacked input can begin
708
# | | | anywhere in a real line and not just at the beginning,
709
# | | | but now it is checked if there was a trailing \n in the
710
# | | | previous stack entry (we do not have to check previous
711
# | | | non stacked lines because there is no way to produce
712
# | | | a beginning paragraph on the stack without a leading
713
# | | | (and therefore stacked) empty line);
714
# | | JSTENZEL | text passed to paragraph filters is now retranslated from
715
# | | | the paragraphs streams (implementation still incomplete);
716
# |21.11.2001| JSTENZEL | macro definitions can now optionally take option defaults;
717
# |22.11.2001| JSTENZEL | bugfix in macro definition tag option handling: no boost!;
718
# |01.12.2001| JSTENZEL | tables can be filtered now;
719
# | | JSTENZEL | Compound paragraphs can be filtered now!
720
# | | JSTENZEL | lists can be filtered now, added retranslation parts;
721
# | | JSTENZEL | slightly restructered lexer parts: new _lineStartResearch();
722
# |02.12.2002| JSTENZEL | slightly restructered lexer parts: new _refLexed()
723
# | | | (to detect streamed parts placed in the input line, must
724
# | | | have beed happened before as well??);
725
# 0.35 |16.06.2001| JSTENZEL | text paragraphs containing an image only are now
726
# | | | transformed into just the image;
727
# |22.07.2001| JSTENZEL | in order to make it run under 5.005 again, a pseudo
728
# | | | hash was replaced by a pure and simple standard hash;
729
# |22.07.2001| JSTENZEL | improved the "specials" pattern in lexer() by guarding "-";
730
# |23.07.2001| JSTENZEL | opening input files in binmode() for Windows compatibility;
731
# 0.34 |14.03.2001| JSTENZEL | added parsing time report;
732
# | | JSTENZEL | slight code optimizations;
733
# |20.03.2001| JSTENZEL | introduced tag templates declared via PerlPoint::Tags:
734
# |22.03.2001| JSTENZEL | bugfix: macros could not contain "0":
735
# | | JSTENZEL | comments are now read at once, no longer lexed and parsed,
736
# | | | likewise, verbatim block lines are handled as one word;
737
# |25.03.2001| JSTENZEL | special character activation in tags is now nearer to the
738
# | | | related grammatical constructs, so "<" is no longer a
739
# | | | special after the tag body is opened;
740
# | | JSTENZEL | completed tag template interface by checks of mandatory
741
# | | | parts and hooks into the parser to check options and body;
742
# |01.04.2001| JSTENZEL | paragraphs using macros or variables are cached now -
743
# | | | they can be reused unless macro/variable settings change;
744
# | | JSTENZEL | cache structure now stores parser version for compatibility
745
# | | | checks;
746
# |08.04.2001| JSTENZEL | removed ACCEPT_ALL support;
747
# | | JSTENZEL | improved special character handling in tag recognition
748
# | | | furtherly: "=" is now very locally specialized;
749
# | | JSTENZEL | tag option and body hooks now take the tag occurence line
750
# | | | number as their first argument, not the tag name which is
751
# | | | of course already known to the hook function author;
752
# | | JSTENZEL | The new macro caching feature allowed to improve the cache
753
# | | | another way: constructions looking like a tag or macro but
754
# | | | being none of them were streamed and cached like strings
755
# | | | (because they *were* strings). If later on somebody declared
756
# | | | such a macro, the cache still found the paragraph unchanged
757
# | | | (same checksum) and reused the old stream instead of building
758
# | | | a new stream on base of the resolved macro. Now, if something
759
# | | | looks like a macro, the macro cache checksum feature is
760
# | | | activated, so every later macro definition will prevent the
761
# | | | cached string representation of being reused. Instead of
762
# | | | this, the new macro will be resolved, and the new resulting
763
# | | | paragraph stream will be cached. This is by far more
764
# | | | transparent and intuitive.
765
# |11.04.2001| JSTENZEL | added predeclared variables;
766
# |19.04.2001| JSTENZEL | embedded Perl code offering no code is ignored now;
767
# |21.04.2001| JSTENZEL | replaced call to Parse::Yapps parser object method YYData()
768
# | | | by direct access to its built in hash entry USER as suggested
769
# | | | by the Parse::Yapp manual for reasons of efficiency;
770
# | | JSTENZEL | bugfix: all parts restored from @inputStack were handled as
771
# | | | new lines which caused several unnecessay operations including
772
# | | | line number updates, cache paragraph checksumming and
773
# | | | removal of "leading" whitespaces (tokens recognized as Ils
774
# | | | while we were still in a formerly started line) - this fix
775
# | | | should accelerate processing of documents using numerous
776
# | | | macros (when cached) and of course avoid invalid token removals;
777
# | | JSTENZEL | tables are now "normalized": if a table row contains less
778
# | | | columns than the headline row, the missed columns are
779
# | | | automatically added (this helps converters to detect empty columns);
780
# | | JSTENZEL | bugfix: internal table flags were not all reset if a table
781
# | | | was completed, thus causing streams for subsequent tables
782
# | | | being built with additional, incorrect elements;
783
# | | JSTENZEL | adapted macro handling to the new tag handling: if now options or
784
# | | | or body was declared in the macro definition, options or body are
785
# | | | not evaluated
786
# |22.04.2001| JSTENZEL | the first bugfix yesterday was too common, improved;
787
# |24.04.2001| JSTENZEL | bugfix: conditions were handled in headline state, causing
788
# | | | backslashes to be removed; new state STATE_CONDITION added;
789
# | | JSTENZEL | added first function (flagSet()) of a simplified condition
790
# | | | interface (SCI) which is intended to allow non (Perl) programmers
791
# | | | to easily understand and perform common checks;
792
# |27.04.2001| JSTENZEL | $^W is a global variable - no need to switch to the Safe
793
# | | | compartment to modify it;
794
# | | JSTENZEL | added next function (varValue()) of a the SCI;
795
# |29.04.2001| JSTENZEL | now the parser predeclares variables as well: first one is
796
# | | | $_STARTDIR to flag where processing started;
797
# |21.05.2001| JSTENZEL | bugfix in table handling: one column tables were not handled
798
# | | | correctly, modified table handling partly by the way si that
799
# | | | in the future it might become possible to have nested tables;
800
# |22.05.2001| JSTENZEL | source nesting level is now reported by an internal variable _SOURCE_LEVEL;
801
# |23.05.2001| JSTENZEL | table fields are trimmed now: beginning and trailing whitespaces are removed;
802
# |24.05.2001| JSTENZEL | text paragraphs containing only a table become just a table now;
803
# |24.05.2001| JSTENZEL | text paragraphs now longer contain a final whitespace (made from the
804
# | | | final carriage return;
805
# |25.05.2001| JSTENZEL | completed support for the new \TABLE flag option "rowseparator" which
806
# | | | allows you to separate table columns by a string of your choice enabling
807
# | | | streamed tables like in
808
# | | | "Look: \TABLE{rowseparator="+++"} c1 | c2 +++ row 2, 1 | row 2, 2 \END_TABLE";
809
# | | JSTENZEL | slightly reorganized the way tag build table streams are completed,
810
# | | | enabling a more common detection of prebuild stream parts - in fact, if
811
# | | | this description makes no sense to you, this enables to place \END_TABLE
812
# | | | even *in* the final table line instead of in a new line (as usually done
813
# | | | and documented);
814
# |26.05.2001| JSTENZEL | added new parser option "nestedTables" which enables table nesting if set
815
# | | | to a true value. made nesting finally possible;
816
# | | JSTENZEL | to help converters handling nested tables, tables now provide their
817
# | | | nesting level by the new internal table option "__nestingLevel__";
818
# |27.05.2001| JSTENZEL | cache hits are no longer mentioned in the list of expected tokens displayed
819
# | | | by _Error(), because the message is intended to be read by humans who
820
# | | | cannot insert cache hits into a document;
821
# |28.05.2001| JSTENZEL | new predeclared variable _PARSER_VERSION;
822
# | | JSTENZEL | new \INCLUDE option "localize";
823
# |31.05.2001| JSTENZEL | new headline level offset keyword "base_level";
824
# |01.06.2001| JSTENZEL | performance boost by lexing words no longer as real words or even
825
# | | | characters but as the longest strings until the next special character;
826
# |02.06.2001| JSTENZEL | improved table field trimming in _normalizeTableRows();
827
# |05.06.2001| JSTENZEL | the last line in a source file is now lexed the optimized way as well;
828
# |06.06.2001| JSTENZEL | cache structure now stores constant declarations version for compatability
829
# | | | checks;
830
# |09.06.2001| JSTENZEL | bugfix: headlines could not begin with a character that can start a
831
# | | | paragraph - fixed by introducing new state STATE_HEADLINE_LEVEL;
832
# | | JSTENZEL | variable names can contain umlauts now;
833
# | | JSTENZEL | updated inlined module documentation (POD);
834
# | | JSTENZEL | used Storable version is now stored in cache, cache is rebuilt
835
# | | | automatically if a different Storable version is detected;
836
# |10.06.2001| JSTENZEL | added code execution by eval() (on users request);
837
# |12.06.2001| JSTENZEL | code executed by eval() or do() is no started with "no strict" settings
838
# | | | to enable unlimited access to functions, like under Safe control
839
# | | | (also this is by no means optimal so it might be improved later);
840
# | | JSTENZEL | tag hooks can reply various values now;
841
# |15.06.2001| JSTENZEL | tags take exactly *one* hook into consideration now: this simplifies
842
# | | | and accelerates the interface *and* allows hooks for tags neither
843
# | | | owning option nor nody;
844
# 0.33 |22.02.2001| JSTENZEL | slightly improved PerlPoint::Parser::DelayedToken;
845
# |25.02.2001| JSTENZEL | variable values can now begin with every character;
846
# |13.03.2001| JSTENZEL | bugfix in handling cache hits for continued ordered lists:
847
# | | | list numbering is updated now;
848
# |14.03.2001| JSTENZEL | added mailing list hint to POD;
849
# | | JSTENZEL | undefined return values of embedded Perl are no longer
850
# | | | tried to be parsed, this is for example useful to
851
# | | | predeclare functions;
852
# | | JSTENZEL | slight bugfix in internal ordered list counting which
853
# | | | takes effect if an ordered list is *started* by "##";
854
# 0.32 |07.02.2001| JSTENZEL | bugfix: bodyless macros can now be used without moving
855
# | | | subsequent tokens before the macro replacement;
856
# |10.02.2001| JSTENZEL | added new special type "example" to \INCLUDE to relieve
857
# | | | people who want to include files just as examples;
858
# 0.31 |30.01.2001| JSTENZEL | ordered lists now provide the entry level number
859
# | | | (additionally to the first list point which already
860
# | | | did this if the list was continued);
861
# |01.02.2001| JSTENZEL | made POD more readable to pod2man;
862
# | | JSTENZEL | bugfix: if a headline is restored from cache, internal
863
# | | | headline level flags need to be restored as well to
864
# | | | make \INCLUDE{headlinebase=CURRENT_LEVEL} work when
865
# | | | it is the first thing in a document except of headlines
866
# | | | which are all restored from cache;
867
# | | JSTENZEL | new "smart" option of \INCLUDE tag suppresses inclusion
868
# | | | if the file was already loaded, which is useful for alias
869
# | | | definitions used both in a nested and the base source;
870
# |02.02.2001| JSTENZEL | bugfix: circular source nesting was supressed too hard:
871
# | | | a source could never be loaded twice, but this may be
872
# | | | really useful to reuse files multiply - now only the
873
# | | | currently nested sources are taken into account;
874
# |03.02.2001| JSTENZEL | bugfix: continued lists did not work as expected yet,
875
# | | | now they do (bug was detected by Lorenz), improved by
876
# | | | the way: continued list points not really continuing
877
# | | | are streamed now as usual list points (no level hint);
878
# 0.30 |05.01.2001| JSTENZEL | slight lexer improvement (removed obsolete code);
879
# | | JSTENZEL | modified the grammar a way that shift/reduce conflicts
880
# | | | were reduced (slightly) and, more important, the grammar
881
# | | | now passes yacc/bison (just a preparation);
882
# |20.01.2001| JSTENZEL | variable settings are now propagated into the stream;
883
# | | JSTENZEL | improved syntactical error messages;
884
# |23.01.2001| JSTENZEL | bugfix: embedding into tags failed because not all
885
# | | | special settings were restored correctly, especially
886
# | | | for ">" which completes a tag body;
887
# |27.01.2001| JSTENZEL | fixed "unintialized value" warning (cache statistics);
888
# | | JSTENZEL | tag implementation is now more restrictive: according
889
# | | | to the language definition tag and macro names now *have*
890
# | | | to be built from capitals and underscores, thus reducing
891
# | | | potential tag recognition confusion with ACCEPT_ALL;
892
# | | JSTENZEL | lowercased alias names in alias definitions are now
893
# | | | automatically converted into capitals because of the
894
# | | | modfied tag/macro recognition just mentioned before;
895
# | | JSTENZEL | POD: added a warning to the POD section that the cache
896
# | | | should be cleansed after introducing new macros which
897
# | | | could possibly be used as simple text before;
898
# 0.29 |21.12.2000| JSTENZEL | direct setting of $VERSION variable to enable CPAN to
899
# | | | detect and display the parser module version;
900
# | | JSTENZEL | introduced base settings for active contents provided
901
# | | | in %$PerlPoint - a new common way to pass things like
902
# | | | the current target language;
903
# |27.12.2000| JSTENZEL | closing angle brackets are to be guarded only *once*
904
# | | | now - in former versions each macro level added the need
905
# | | | of yet another backslash;
906
# |28.12.2000| JSTENZEL | macro bodies are no longer reparsed which accelerates
907
# | | | procesing of nested macros drastically (and avoids the
908
# | | | overhead and dangers of rebuilding a source string and
909
# | | | parsing it again - this way, parsing becomes easier to
910
# | | | maintain in case of syntax extensions (nevertheless, the
911
# | | | old code worked well!);
912
# 0.28 |14.12.2000| JSTENZEL | made it finally backward compatible to perl 5.005 again;
913
# 0.27 |07.12.2000| JSTENZEL | moved package namespace from "PP" to "PerlPoint";
914
# 0.26 |30.11.2000| JSTENZEL | "Perl Point" => "PerlPoint";
915
# |02.12.2000| JSTENZEL | bugfix in _stackInput() which could remove input lines;
916
# | | JSTENZEL | new headline level offset keyword "current_level";
917
# |03.12.2000| JSTENZEL | the parser now changes into a sourcefiles directory thus
918
# | | | getting able to follow relative paths in nested sources;
919
# | | JSTENZEL | bugfix in input stack: must be multi levelled - we need
920
# | | | one input stack per processed source!;
921
# | | JSTENZEL | cache data now contains headline level informations;
922
# 0.25 |22.11.2000| JSTENZEL | added notes about Storable updates;
923
# |24.11.2000| JSTENZEL | bugfix in caching of embedded parts including empty lines;
924
# | | JSTENZEL | bugfix in modified ordered point intro handling;
925
# |27.11.2000| JSTENZEL | bugfix in progress visualization;
926
# | | JSTENZEL | improved progress visualization;
927
# | | JSTENZEL | new experimental tag setting "\ACCEPT_ALL";
928
# 0.24 |10.11.2000| JSTENZEL | added incremental parsing ("caching");
929
# |18.11.2000| JSTENZEL | slightly simplified the code;
930
# | | JSTENZEL | added ordered list continuations;
931
# 0.23 |28.10.2000| JSTENZEL | bugfix: indentation in embedded code was not accepted;
932
# | | JSTENZEL | using an input stack now for improved embedding;
933
# | | JSTENZEL | tracing active contents now;
934
# 0.22 |21.10.2000| JSTENZEL | new \INCLUDE headline offset parameter;
935
# |25.10.2000| JSTENZEL | bugfixes in trace code;
936
# | | JSTENZEL | modified implementation of included file handling:
937
# | | | reopening a handle did not work in all cases with perl5.6;
938
# 0.21 |11.10.2000| JSTENZEL | improved table paragraphs;
939
# |14.10.2000| JSTENZEL | added alias/macro feature;
940
# 0.20 |10.10.2000| JSTENZEL | added table paragraphs;
941
# 0.19 |08.10.2000| JSTENZEL | added condition paragraphs;
942
# |09.10.2000| JSTENZEL | bugfix in table handling: generated stream was wrong;
943
# 0.18 |05.10.2000| JSTENZEL | embedded Perl code is evaluated now, method run() takes
944
# | | | a Safe object;
945
# |07.10.2000| JSTENZEL | Perl code can now be included as well as embedded;
946
# | | JSTENZEL | variable values are now accessible by embedded and
947
# | | | included Perl code;
948
# | | JSTENZEL | PerlPoint can now be embedded as well as included;
949
# 0.17 |04.10.2000| JSTENZEL | bugfix in documentation: colons have not to be guarded
950
# | | | in definition texts;
951
# | | JSTENZEL | bugfixes in special token handling;
952
# 0.16 |30.09.2000| JSTENZEL | updated documentation;
953
# | | JSTENZEL | bugfix in special token handling;
954
# |03.10.2000| JSTENZEL | definition list items can contain tags now;
955
# |04.10.2000| JSTENZEL | added new target language filter feature;
956
# 0.15 |06.06.2000| JSTENZEL | there were still 5.6 specific operations, using
957
# | | | IO::File now as an emulation under perl 5.005;
958
# 0.14 |03.06.2000| JSTENZEL | improved handling of special tag characters to simplify
959
# | | | PP writing;
960
# | | JSTENZEL | bugfixes: stream contained trailing whitespaces for
961
# | | | list points and headlines;
962
# | | JSTENZEL | bugfix: empty lines in verbatim blocks were not
963
# | | | streamed;
964
# | | JSTENZEL | bugfix: stream contained leading newline for verbatim
965
# | | | blocks;
966
# |05.06.2000| JSTENZEL | switched back to 5.005 open() syntax to become compatible;
967
# 0.13 |01.06.2000| JSTENZEL | made it 5.003 compatible again;
968
# 0.12 |27.05.2000| JSTENZEL | leading spaces in list point lines are suppressed now;
969
# | | JSTENZEL | bugfix in run(): did not supply correct a return code;
970
# | | JSTENZEL | bugfix: last semantic action must be a true value to
971
# | | | flag success (to the parser);
972
# 0.11 |20.05.2000| JSTENZEL | completed embedding feature;
973
# |21.05.2000| JSTENZEL | bugfix in semantic error counting;
974
# | | JSTENZEL | added include feature;
975
# |27.05.2000| JSTENZEL | added table feature (first version);
976
# 0.10 |17.04.2000| JSTENZEL | still incomplete embedding code added;
977
# |03.05.2000| JSTENZEL | bugfix: verbatim block opener was added to stream
978
# | | | because of the modified syntax (not completely impl.);
979
# 0.09 |11.04.2000| JSTENZEL | reorganized verbatim block start: spaces between "&"
980
# | | | and "<
981
# | | | paragraphs with a startup "&" character are allowed now;
982
# | | JSTENZEL | added new paragraph type "definition list point";
983
# |14.04.2000| JSTENZEL | streamed lists are embedded into list directives now;
984
# |15.04.2000| JSTENZEL | modified syntax of verbatim blocks;
985
# | | JSTENZEL | added variables;
986
# | | JSTENZEL | modified tag syntax into "\TAG[{parlist}][]";
987
# 0.08 |04.04.2000| JSTENZEL | started to implement the new pp2xy concept;
988
# |07.04.2000| JSTENZEL | headlines are terminated by a REAL empty line now;
989
# | | JSTENZEL | old "points" became "unordered list points";
990
# | | JSTENZEL | added new paragraph type "ordered list point";
991
# |08.04.2000| JSTENZEL | built in list shifting;
992
# |09.04.2000| JSTENZEL | bugfix in text paragraph rule;
993
# |10.04.2000| JSTENZEL | blocks are combined now automatically unless there is an
994
# | | | intermediate control paragraph;
995
# 0.07 |25.03.2000| JSTENZEL | tag length is now 1 to 8 characters (instead of 1 to 3);
996
# | | JSTENZEL | POD fixes;
997
# | | JSTENZEL | using CPAN id's in HOC now;
998
# 0.06 |24.02.2000| JSTENZEL | trailing whitespaces in input lines are now removed
999
# | | | (except of newlines!);
1000
# 0.05 |11.10.1999| JSTENZEL | bugfix: paragraphs generated array references;
1001
# | | JSTENZEL | PP::Parser::Constants became PP::Constants;
1002
# | | JSTENZEL | adapted POD to pod2text (needs more blank lines);
1003
# 0.04 |09.10.1999| JSTENZEL | moved certain constants into PP::Parser::Constants;
1004
# | | JSTENZEL | completed POD;
1005
# 0.03 |08.10.1999| JSTENZEL | started to generate intermediate data;
1006
# | | JSTENZEL | simplified array access;
1007
# | | JSTENZEL | bugfixes;
1008
# |09.10.1999| JSTENZEL | added data generation;
1009
# | | JSTENZEL | all messages are written in English now;
1010
# | | JSTENZEL | tags are declared outside now;
1011
# | | JSTENZEL | exported the script part;
1012
# | | JSTENZEL | added statistics;
1013
# | | JSTENZEL | added trace and display control;
1014
# 0.02 |07.10.1999| JSTENZEL | added C tag;
1015
# | | JSTENZEL | added comment traces;
1016
# | | JSTENZEL | bugfixes;
1017
# | | JSTENZEL | made it pass -w;
1018
# | | JSTENZEL | new "verbatim" paragraph;
1019
# 0.01 |28.09.1999| JSTENZEL | new.
1020
# ---------------------------------------------------------------------------------------
1021
1022
# = POD SECTION =========================================================================
1023
1024
=head1 NAME
1025
1026
B - a PerlPoint Parser
1027
1028
=head1 VERSION
1029
1030
This manual describes version B<0.451>.
1031
1032
=head1 SYNOPSIS
1033
1034
# load the module:
1035
use PerlPoint::Parser;
1036
1037
# build the parser and run it
1038
# to get intermediate data in @stream
1039
my ($parser)=new PerlPoint::Parser;
1040
$parser->run(
1041
stream => \@stream,
1042
files => \@files,
1043
);
1044
1045
1046
=head1 DESCRIPTION
1047
1048
The PerlPoint format, initially designed by Tom Christiansen, is intended
1049
to provide a simple and portable way to generate slides without the need of
1050
a proprietary product. Slides can be prepared in a text editor of your choice,
1051
generated on any platform where you find perl, and presented by any browser
1052
which can render the chosen output format.
1053
1054
To sum it up,
1055
I
1056
This is, by tradition, usually HTML, but you may decide to use another format like
1057
XML, SGML, TeX or whatever you want.
1058
1059
Well, this sounds fine, but how to build a translator which transforms ASCII
1060
into the output format of your choice? Thats what B is made for.
1061
It performs the first translation step by parsing ASCII and transforming it
1062
into an intermediate stream format, which can be processed by a subsequently
1063
called translator backend. By separating parsing and output generation we
1064
get the flexibility to write as many backends as necessary by using the same
1065
parser frontend for all translators.
1066
1067
B supports the complete I with exception of I
1068
tags. Tags I supported the I: the parser recognizes I
1069
tag which is declared by the author of a translator. This way the
1070
parser can be used for various flavours of the PerlPoint language without
1071
having to be modified. So, if there is a need of a certain new flag, it can
1072
quickly be added without any change to B.
1073
1074
The following chapters describe the input format (I) and the
1075
generated stream format (I). Finally, the class methods are
1076
described to show you how to build a parser.
1077
1078
1079
=head1 GRAMMAR
1080
1081
This chapter describes how a PerlPoint ASCII slide description has to be
1082
formatted to pass B parsers.
1083
1084
I that the input format does I completely determine how
1085
the output will be designed. The final I depends on the backend
1086
which has to be called after the parser to transform its output into a
1087
certain document description language. The final I depends on
1088
the I behaviour.
1089
1090
Each PerlPoint document is made of I.
1091
1092
=head2 The paragraphs
1093
1094
All paragraphs start at the beginning of their first line. The first character
1095
or string in this line determines which paragraph is recognized.
1096
1097
A paragraph is completed by an empty line (which may contain whitespaces).
1098
Exceptions are described.
1099
1100
Carriage returns in paragraphs which are completed by an empty line
1101
are transformed into a whitespace.
1102
1103
=over 4
1104
1105
=item Comments
1106
1107
start with "//" and reach until the end of the line.
1108
1109
1110
=item Headlines
1111
1112
start with one or more "=" characters.
1113
The number of "=" characters represents the headline level.
1114
1115
=First level headline
1116
1117
==Second level headline
1118
1119
===Multi
1120
line
1121
headline
1122
example
1123
1124
It is possible to declare a "short version" of the headline
1125
title by appending a "~" and plain strings to the headline
1126
like in
1127
1128
=Very long headlines are expressive but may exceed the
1129
available space for example in HTML navigation bars or
1130
something like that ~ Long headlines
1131
1132
The "~" often stands for similarity, or represents the described
1133
object in encyclopedias or dictionaries. So one may think of this
1134
as "long title is (sometimes) similar to short title".
1135
1136
1137
1138
=item Lists
1139
1140
B or B start with a "*" character.
1141
1142
* This is a first point.
1143
1144
* And, I forgot,
1145
there is something more to point out.
1146
1147
There are B as well, and I start with a hash sign ("#"):
1148
1149
# First, check the number of this.
1150
1151
# Second, don't forget the first.
1152
1153
The hash signs are intended to be replaced by numbers by a backend.
1154
1155
Because PerlPoint works on base of paragraphs, any paragraph different to
1156
an ordered list point I. If you wish the list to
1157
be continued use a double hash sign in case of the single one in the point
1158
that reopens the list.
1159
1160
# Here the ordered list begins.
1161
1162
? $includeMore
1163
1164
## This is point 2 of the list that started before.
1165
1166
# In subsequent points, the usual single hash sign
1167
works as expected again.
1168
1169
List continuation works list level specific (see below for level details).
1170
A list cannot be continued in another chapter. Using "##" in the first
1171
point of a new list takes no special effect: the list will begin as usual
1172
(with number 1).
1173
1174
B are a third list variant. Each item starts with the
1175
described phrase enclosed by a pair of colons, followed by the definition
1176
text:
1177
1178
:first things: are usually described first,
1179
1180
:others: later then.
1181
1182
All lists can be I. A new level is introduced by
1183
a special paragraph called I<"list indention"> which starts with a ">". A list level
1184
can be terminated by a I<"list indention stop"> paragraph starting with a "<"
1185
character. (These startup characters symbolize "level shifts".)
1186
1187
* First level.
1188
1189
* Still there.
1190
1191
>
1192
1193
* A list point of the 2nd level.
1194
1195
<
1196
1197
* Back on first level.
1198
1199
It is possible to shift more than one level by adding a number. There should be no whitespace between the
1200
level shift character and the level number.
1201
1202
* First level.
1203
1204
>
1205
1206
* Second level.
1207
1208
>
1209
1210
* Third level.
1211
1212
<2
1213
1214
* Back on first level.
1215
1216
Level shifts are accepted between list items I.
1217
1218
I Any non list
1219
paragraph will I list indentation, as well as the end of the source.
1220
1221
1222
=item Texts
1223
1224
are paragraphs like points but begin I without a startup
1225
character:
1226
1227
This is a simple text.
1228
1229
In this new text paragraph,
1230
we demonstrate the multiline feature.
1231
1232
I, a text paragraph can be started with a special character
1233
as well, which is a dot:
1234
1235
.This is a simple text with dot.
1236
1237
.In this new text paragraph,
1238
we demonstrate the multiline feature.
1239
1240
This is intended to be used by generators which translate other formats
1241
into PerlPoint, to make sure the first character of a paragraph has no
1242
special meaning to the PerlPoint parser.
1243
1244
1245
=item Blocks
1246
1247
are intended to contain examples or code I tag recognition.
1248
This means that the parser will discover embedded tags. On the other hand,
1249
it means that one may have to escape ">" characters embedded into tags. Blocks
1250
begin with an I and are completed by the next empty line.
1251
1252
* Look at these examples:
1253
1254
A block.
1255
1256
\I block.
1257
Escape ">" in tags: \C<<\>>.
1258
1259
Examples completed.
1260
1261
Subsequent blocks are joined together automatically: the intermediate empty
1262
lines which would usually complete a block are translated into real empty
1263
lines I the block. This makes it easier to integrate real code
1264
sequences as one block, regardless of the empty lines included. However,
1265
one may explicitly I to separate subsequent blocks and can do so
1266
by delimiting them by a special control paragraph:
1267
1268
* Separated subsequent blocks:
1269
1270
The first block.
1271
1272
-
1273
1274
The second block.
1275
1276
Note that the control paragraph starts at the left margin.
1277
1278
1279
=item Verbatim blocks
1280
1281
are similar to blocks in indentation but I
1282
pattern recognition. That means the embedded text is I scanned for tags
1283
and empty lines and may therefore remain as it was in its original place,
1284
possibly a script.
1285
1286
These special blocks need a special syntax. They are implemented as here documents.
1287
Start with a here document clause flagging which string will close the "here document":
1288
1289
<
1290
1291
PerlPoint knows various
1292
tags like \B, \C and \I. # unrecognized tags
1293
1294
EOC
1295
1296
1297
=item Tables
1298
1299
are supported as well, they start with an @ sign which is
1300
followed by the column delimiter:
1301
1302
@|
1303
column 1 | column 2 | column 3
1304
aaa | bbb | ccc
1305
uuu | vvvv | www
1306
1307
The first line is automatically marked as a "table headline". Most converters
1308
emphasize such headlines by bold formatting, so there is no need to insert \B
1309
tags into the document.
1310
1311
If a table row contains less columns than the table headline, the "missed"
1312
columns are automatically added. This is,
1313
1314
@|
1315
A | B | C
1316
1
1317
1 |
1318
1 | 2
1319
1 | 2 |
1320
1 | 2 | 3
1321
1322
is streamed exactly like
1323
1324
@|
1325
A | B | C
1326
1 | |
1327
1 | |
1328
1 | 2 |
1329
1 | 2 |
1330
1 | 2 | 3
1331
1332
to make backend handling easier. (Empty HTML table cells, for example, are rendered
1333
slightly obscure by certain browsers unless they are filled with invisible characters,
1334
so a converter to HTML can detect such cells because of normalization and handle them
1335
appropriately.)
1336
1337
Please note that normalization refers to the headline row. If another line contains
1338
I columns than the headline, normalization does not care. If the maximum column
1339
number is detected in another row, a warning is issued. (As a help for converter authors,
1340
the title and maximum column number are made part of a table tag as internal options
1341
C<__titleColumns__> and C<__maxColumns__>.)
1342
1343
In all tables, leading and trailing whitespaces of a cell are
1344
automatically removed, so you can use as many of them as you want to
1345
improve the readability of your source. The following table is absolutely
1346
equivalent to the last example:
1347
1348
@|
1349
A | B | C
1350
1 | |
1351
1 | |
1352
1 | 2 |
1353
1 | 2 |
1354
1 | 2 | 3
1355
1356
There is also a more sophisticated way to describe tables, see the tag section below.
1357
1358
Note: Although table paragraphs cannot be nested, tables declared by tag possibly
1359
I (and might be embedded into table paragraphs as well). To help converter authors
1360
handling nested tables, the opening table tag provides an internal option "__nestingLevel__".
1361
1362
1363
=item Conditions
1364
1365
start with a "?" character. If active contents is enabled, the paragraph text
1366
is evaluated as Perl code. The (boolean) evaluation result then determines if
1367
subsequent PerlPoint is read and parsed. If the result is false, all subsequent
1368
paragraphs until the next condition are I.
1369
1370
Note that base data is made available by a global (package) hash reference
1371
B<$PerlPoint>. See I for details about how to set up these data.
1372
1373
Conditions can be used to maintain various language versions of a presentation
1374
in one source file:
1375
1376
? $PerlPoint->{targetLanguage} eq 'German'
1377
1378
Or you could enable parts of your document by date:
1379
1380
? time>$dateOfTalk
1381
1382
or by a special setting:
1383
1384
? flagSet('setting')
1385
1386
Please note that the condition code shares its variables with embedded and included
1387
code.
1388
1389
To make usage easier and to improve readability, condition code is evaluated with
1390
disabled warnings (the language variable in the example above may not even been set).
1391
1392
Converter authors might want to provide predefined variables such as "$language"
1393
in the example.
1394
1395
Note: If a document uses I, be careful in intermixing docstream
1396
entry points and conditions. A condition placed in a skipped document stream will
1397
not e evaluated. A document stream entry point placed in a source area hidden by
1398
a false condition will not be reconized.
1399
1400
1401
=item Variable assignment paragraphs
1402
1403
Variables can be used in the text and will be automatically replaced by their string
1404
values (if declared).
1405
1406
The next paragraph sets a variable.
1407
1408
$var=var
1409
1410
This variable is called $var.
1411
1412
All variables are made available to embedded and included Perl code as well as to
1413
conditions and can be accessed there as package variables of "main::" (or whatever
1414
package name the Safe object is set up to). Because a
1415
variable is already replaced by the parser if possible, you have to use the fully
1416
qualified name or to guard the variables "$" prefix character to do so:
1417
1418
\EMBED{lang=perl}join(' ', $main::var, \$var)\END_EMBED
1419
1420
Variable modifications by embedded or included Perl I affect the variables
1421
visible to the parser. (This is true for conditions as well.) This means that
1422
1423
$var=10
1424
\EMBED{lang=perl}$main::var*=2;\END_EMBED
1425
1426
causes I<$var> to be different on parser and code side - the parser will still use a
1427
value of 10, while embedded code works on with a value of 20.
1428
1429
=item Macro or alias definitions
1430
1431
Sometimes certain text parts are used more than once. It would be a relieve
1432
to have a shortcut instead of having to insert them again and again. The same
1433
is true for tag combinations a user may prefer to use. That's what I
1434
(or "macros") are designed for. They allow a presentation author to declare
1435
his own shortcuts and to use them like a tag. The parser will resolve such aliases,
1436
replace them by the defined replacement text and work on with this replacement.
1437
1438
An alias declaration starts with a "+" character followed I by the
1439
alias I (without backslash prefix), optionally followed I
1440
by an option default list in "{}", followed I by a colon.
1441
(No additional spaces here.)
1442
1443
I
1444
So, whereever you will use the new macro, the parser will replace it by this
1445
text and I the result. This means that your macro text can contain
1446
any valid constructions like tags or other macros.
1447
1448
The replacement text may contain strings embedded into doubled underscores like
1449
C<__this__>. This is a special syntax to mark that the macro takes parameters
1450
of these names (e.g. C). If a macro is used and these parameters are set,
1451
their values will replace the mentioned placeholders. The special placeholder
1452
"__body__" is used to mark where the macro I is to place.
1453
1454
If a macro is used and defined options are I, but there are defaults
1455
for them in the optional default list, these defaults will be used for the
1456
respective options.
1457
1458
Here are a few examples:
1459
1460
+RED:\FONT{color=red}<__body__>
1461
1462
+F:\FONT{color=__c__}<__body__>
1463
1464
+COLORED{c=blue}:\FONT{color=__c__}<__body__>
1465
1466
+IB:\B<\I<__body__>>
1467
1468
This \IB is \RED.
1469
1470
Defaults: first, text in \COLORED{c=red},
1471
now text in \COLORED.
1472
1473
+TEXT:Macros can be used to abbreviate longer
1474
texts as well as other tags
1475
or tag combinations.
1476
1477
+HTML:\EMBED{lang=html}
1478
1479
Tags can be \RED<\I> into macros.
1480
And \I<\F{c=blue}>.
1481
\IB<\RED> is formatted by nested macros.
1482
\HTML This is embedded HTML \END_EMBED.
1483
1484
Please note: \TEXT
1485
1486
I
1487
The same is true for the body part.
1488
I is used in the macro definition, macro bodies will not be recognized.>
1489
This means that with the definition
1490
1491
+OPTIONLESS:\B<__body__>
1492
1493
the construction
1494
1495
\OPTIONLESS{something=this}
1496
1497
is evaluated as a usage of C<\OPTIONLESS> without body, followed by the I
1498
C<{something=here}>. Likewise, the definition
1499
1500
+BODYLESS:found __something__
1501
1502
causes
1503
1504
\BODYLESS{something=this}
1505
1506
to be recognized as a usage of C<\BODYLESS> with option C, followed
1507
by the I C<>. So this will be resolved as C. Finally,
1508
1509
+JUSTTHENAME:Text phrase.
1510
1511
enforces these constructions
1512
1513
... \JUSTTHENAME, ...
1514
... \JUSTTHENAME{name=Name}, ...
1515
... \JUSTTHENAME, ...
1516
... \JUSTTHENAME{name=Name} ...
1517
1518
to be translated into
1519
1520
... Text phrase. ...
1521
... Text phrase.{name=Name} ...
1522
... Text phrase., ...
1523
... Text phrase.{name=Name} ...
1524
1525
The principle behind all this is to make macro usage I and intuative:
1526
why think of options or a body or of special characters possibly treated as
1527
option/body part openers unless the macro makes use of an option or body?
1528
1529
An I macro text I the macro (if it was already known).
1530
1531
// undeclare the IB alias
1532
+IB:
1533
1534
An alias can be used like a tag.
1535
1536
Aliases named like a tag I the tag (as long as they are defined).
1537
1538
1539
=item Document stream entry points
1540
1541
A document stream is a "document in document" and best explained by example.
1542
1543
Consider a document talking about
1544
two scripts and comparing them. A
1545
typical review of this type is
1546
structured this way: headline, notes
1547
about script 1, notes about script 2,
1548
new headline to discuss another aspect,
1549
notes about script 1, notes about
1550
script 2, and so on.
1551
1552
Everything said about item 1 is a document stream, everything about object 2
1553
as well. and a third stream is implicitly built by all parts outside these
1554
two. In slide construction, each stream can have its own area, for example
1555
1556
-------------------------------------
1557
| |
1558
| main stream |
1559
| |
1560
-------------------------------------
1561
| | |
1562
| item 1 stream | item 2 stream |
1563
| | |
1564
-------------------------------------
1565
1566
But to construct a layout like this, streams need to be distinguished, and
1567
that is what "stream entry points" are made for.
1568
1569
A stream entry point starts with a "~" character, followed by a string
1570
which is the name of the stream. This may be an internal name only, or
1571
converters may turn it into a document part as well. The C<__ALL__> string
1572
is reserved for internal purposes. It is recommended to treat C<__MAIN__>
1573
as reserved as well, although it has no special meaning yet.
1574
1575
Once an entry point was passed, all subsequent document parts belong to the
1576
declared stream, up to the next entry point or a headline which implicitly
1577
switches back to the "main stream".
1578
1579
The parser can be instructed to ignore certain streams, see I for
1580
details. If this feature is used, please be careful in intermixing stream
1581
entry points and conditions. A condition placed in a skipped document
1582
stream will not be evaluated.
1583
1584
I Certain converters
1585
may ignore them at all. As a convenient solution, the parser can be instructed
1586
to transform stream entry points into headlines (one level below the current
1587
real headline level). See I for details.
1588
1589
1590
1591
=back
1592
1593
=head2 Tags
1594
1595
Tags are directives embedded into the text stream, commanding how certain parts
1596
of the text should be interpreted. Tags are declared by using one or more modules
1597
build on base of B.
1598
1599
use PerlPoint::Tags::Basic;
1600
1601
B parsers can recognize all tags which are build of a backslash
1602
and a number of capitals and numbers.
1603
1604
\TAG
1605
1606
I are optional and follow the tag name immediately, enclosed
1607
by a pair of corresponding curly braces. Each option is a simple string
1608
assignment. The value has to be quoted if /^\w+$/ does not match it.
1609
1610
\TAG{par1=value1 par2="www.perl.com" par3="words and blanks"}
1611
1612
The I is anything you want to make the tag valid for. It is optional
1613
as well and immediately follows the optional parameters, enclosed by "<" and ">":
1614
1615
\TAG
1616
\TAG{par=value}
1617
1618
Tags can be I.
1619
1620
To provide a maximum of flexibility, tags are declared I the parser.
1621
This way a translator programmer is free to implement the tags he needs. It is
1622
recommended to always support the basic tags declared by B.
1623
On the other hand,a few tags of special meaning are reserved and cannot be declared
1624
by converter authors, because they are handled by the parser itself. These are:
1625
1626
=over 4
1627
1628
=item \INCLUDE
1629
1630
It is possible to include a file into the input stream. Have a look:
1631
1632
\INCLUDE{type=HTML file=filename}
1633
1634
This imports the file "filename". The file contents is made part of the
1635
generated stream, but not parsed. This is useful to include target language
1636
specific, preformatted parts.
1637
1638
If, however, the file type is specified as "PP", the file contents is
1639
made part of the input stream and parsed. In this case a special tag option
1640
"headlinebase" can be specified to define a headline base level used as
1641
an offset to all headlines in the included document. This makes it easier
1642
to share partial documents with others, or to build complex documents by
1643
including separately maintained parts, or to include one and the same
1644
part at different headline levels.
1645
1646
Example: If "\INCLUDE{type=PP file=file headlinebase=20}" is
1647
specified and "file" contains a one level headline
1648
like "=Main topic of special explanations"
1649
this headline is detected with a level of 21.
1650
1651
Pass the special keyword "CURRENT_LEVEL" to this tag option if you want to
1652
set just the I headline level as an offset. This results in
1653
"subchapters".
1654
1655
Example:
1656
1657
===Headline 3
1658
1659
// let included chapters start on level 4
1660
\INCLUDE{type=PP file=file headlinebase=CURRENT_LEVEL}
1661
1662
Similar to "CURRENT_LEVEL", "BASE_LEVEL" sets the current I
1663
headline level as an offset. The "base level" is the level above
1664
the current one. Using "BASE_LEVEL" results in parallel chapters.
1665
1666
Example:
1667
1668
===Headline 3
1669
1670
// let included chapters start on level 3
1671
\INCLUDE{type=PP file=file headlinebase=BASE_LEVEL}
1672
1673
A given offset is reset when the included document is parsed completely.
1674
1675
A second special option I commands the parser to include the file
1676
only unless this was already done before. This is intended for inclusion
1677
of pure alias/macro definition or variable assignment files.
1678
1679
\INCLUDE{type=PP file="common-macros.pp" smart=1}
1680
1681
Included sources may declare variables of their own, possibly overwriting
1682
already assigned values. Option "localize" works like Perls C:
1683
such changes will be reversed after the nested source will have been
1684
processed completely, so the original values will be restored. You can
1685
specify a comma separated list of variable names or the special string
1686
C<__ALL__> which flags that I current settings shall be restored.
1687
1688
\INCLUDE{type=PP file="nested.pp" localize=myVar}
1689
1690
\INCLUDE{type=PP file="nested.pp" localize="var1, var2, var3"}
1691
1692
\INCLUDE{type=PP file="nested.pp" localize=__ALL__}
1693
1694
1695
PerlPoint authors can declare an I
1696
included file. This is done via option I:
1697
1698
\INCLUDE{type=pp file="source.pod" ifilter="pod2pp()"}
1699
1700
An input filter is a snippet of user defined Perl code, taking the
1701
included file via C<@main::_ifilterText> and the target type via
1702
C<$main::_ifilterType>. The original filename can be accessed via
1703
C<$main::_ifilterType>. It should supply its result as an array
1704
of strings which will then be processed instead of the original file.
1705
1706
Input filters are Active Content. If Active Content is disabled,
1707
\INCLUDE tags using input filters will be ignored I.
1708
1709
1710
As a simplified option, C allows to use I
1711
import filters defined in C modules. To use
1712
such a filter do I set the C option, set C instead.
1713
C takes the name of the source format, like "POD", or a true
1714
number to indicate that the file extension should be used as the source
1715
format name. The uppercased name is used as the final part of the filter
1716
module - for "POD", the modules name would be "PerlPoint::Import::POD".
1717
If this module is installed and has a function C this
1718
function name is used like C.
1719
1720
Here are a few examples:
1721
1722
\INCLUDE{file="source.pod" import=1}
1723
1724
\INCLUDE{file="source.pod" import=pod}
1725
1726
\INCLUDE{file=source import=pod}
1727
1728
Please note that in the last example C will not work, as the
1729
source file has no extension that indicates its format is POD.
1730
1731
If C is used together with C, C is ignored.
1732
1733
1734
A PerlPoint file can be included wherever a tag is allowed, but sometimes
1735
it has to be arranged slightly: if you place the inclusion directive at
1736
the beginning of a new paragraph I your included PerlPoint starts by
1737
a paragraph of another type than text, you should begin the included file
1738
by an empty line to let the parser detect the correct paragraph type. Here
1739
is an example: if the inclusion directive is placed like
1740
1741
// include PerlPoint
1742
\INCLUDE{type=pp file="file.pp"}
1743
1744
and file.pp immediately starts with a verbatim block like
1745
1746
<
1747
verbatim
1748
VERBATIM
1749
1750
, I which is detected to
1751
be "text" (because there is no special startup character). Now in the included
1752
file, from the parsers point of view the included PerlPoint is simply a
1753
continuation of this text, because a paragraph ends with an empty line. This
1754
trouble can be avoided by beginning the included file by an empty line,
1755
so that its first paragraph can be detected correctly.
1756
1757
The second special case is a file type of "Perl". If active contents is enabled,
1758
included Perl code is read into memory and evaluated like I Perl. The
1759
results are made part of the input stream to be parsed.
1760
1761
// execute a perl script and include the results
1762
\INCLUDE{type=perl file="disk-usage.pl"}
1763
1764
As another option, files may be declared to be of type "example" or "parsedexample".
1765
This makes the file placed into the source as a verbatim block (with "example"), or
1766
a standard block (with "parsedexample"), respectively, without need to copy its contents
1767
into the source.
1768
1769
// include an external script as an example
1770
\INCLUDE{type=example file="script.csh"}
1771
1772
All lines of the example file are included as they are but can be indented on request.
1773
To do so, just set the special option "indent" to a positive numerical value equal to
1774
the number of spaces to be inserted before each line.
1775
1776
// external example source, indented by 3 spaces
1777
\INCLUDE{type=example file="script.csh" indent=3}
1778
1779
Including external scripts this way can accelerate PerlPoint authoring significantly,
1780
especially if the included files are still subject to changes.
1781
1782
It is possible to filter the file types you wish to include (with exception
1783
of "pp" and "example"), see below for details. I, the mentioned file
1784
has to exist.
1785
1786
1787
1788
=item \EMBED and \END_EMBED
1789
1790
Target format code does not necessarily need to be imported - it can be
1791
directly I as well. This means that one can write target language
1792
code within the input stream using I<\EMBED>:
1793
1794
\EMBED{lang=HTML}
1795
This is embedded HTML
1796
The parser detects no PerlPoint
1797
tag here, except of END_EMBED .
1798
\END_EMBED
1799
1800
Because this is handled by I, not by paragraphs, it can be placed
1801
directly in a text like this:
1802
1803
These \EMBED{lang=HTML}italics \END_EMBED
1804
are formatted by HTML code.
1805
1806
Please note that the EMBED tag does not accept a tag body (to avoid
1807
ambiguities).
1808
1809
Both tag and embedded text are made part of the intermediate stream.
1810
It is the backends task to deal with it. The only exception of this rule
1811
is the embedding of I code, which is evaluated by the parser.
1812
The reply of this code is made part of the input stream and parsed as
1813
usual.
1814
1815
PerlPoint authors can declare an I
1816
embedded text. This is done via option I:
1817
1818
\EMBED{lang=pp ifilter="pod2pp()"}
1819
1820
=head1 POD formatted part
1821
1822
This part was written in POD.
1823
1824
\END_EMBED
1825
1826
An input filter is a snippet of user defined Perl code, taking the
1827
embedded text via C<@main::_ifilterText> and the target language via
1828
C<$main::_ifilterType>. The original filename can be accessed via
1829
C<$main::_ifilterType> (but please note that this is the source with
1830
the \EMBED tag). It should supply its result as an array of
1831
strings which will then be processed as usual.
1832
1833
Input filters are Active Contents. If Active Contents is disabled,
1834
embedded parts using input filters will be ignored I.
1835
1836
It is possible to filter the languages you wish to embed (with exception
1837
of "PP"), see below for details.
1838
1839
1840
=item \TABLE and \END_TABLE
1841
1842
It was mentioned above that tables can be built by table paragraphs.
1843
Well, there is a tag variant of this:
1844
1845
\TABLE{bg=blue separator="|" border=2}
1846
\B | \B | \B
1847
aaaa | bbbb | cccc
1848
uuuu | vvvv | wwww
1849
\END_TABLE
1850
1851
This is sligthly more powerfull than the paragraph syntax: you can set
1852
up several table features like the border width yourself, and you can
1853
format the headlines as you like.
1854
1855
As in all tables, leading and trailing whitespaces of a cell are
1856
automatically removed, so you can use as many of them as you want to
1857
improve the readability of your source.
1858
1859
The default row separator (as in the example above) is a carriage return,
1860
so that each table line can be written as a separate source line. However,
1861
PerlPoint allows you to specify another string to separate rows by option
1862
C. This allows to specify a table I into a paragraph.
1863
1864
\TABLE{bg=blue separator="|" border=2 rowseparator="+++"}
1865
\B | \B | \B +++ aaaa
1866
| bbbb | cccc +++ uuuu | vvvv| wwww \END_TABLE
1867
1868
This is exactly the same table as above.
1869
1870
If parser option I is set to a true value calling I,
1871
it is possible to I tables. To help converter authors handling this,
1872
the opening table tag provides an internal option "__nestingLevel__".
1873
1874
Tables built by tag are normalized the same way as table paragraphs are.
1875
1876
=back
1877
1878
1879
=head2 What about special formatting?
1880
1881
Earlier versions of B supported special format hints like the HTML
1882
expression ">" for the ">" character, or "ü" for "ü". B
1883
does I support this directly because such hints are specific to the
1884
I - if someone wants to translate into TeX, it might be curious
1885
for him to use HTML syntax in his ASCII text. Further more, such hints can be
1886
handled I by a backend which finds them unchanged in the produced
1887
output stream.
1888
1889
The same is true for special headers and trailers. It is a I task to
1890
add them if necessary. The parser does handle the I
1891
1892
1893
=head1 STREAM FORMAT
1894
1895
It is suggested to use B to evaluate the intermediate format.
1896
Nevertheless, here is the documentation of this format.
1897
1898
The generated stream is an array of tokens. Most of them are very simple,
1899
representing just their contents - words, spaces and so on. Example:
1900
1901
"These three words."
1902
1903
could be streamed into
1904
1905
"These three" + " "+ "words."
1906
1907
(This shows the principle. Actually this complete sentence would be replied as
1908
I token for reasons of effeciency.)
1909
1910
Note that the final dot I of the last token. From a document
1911
description view, this should make no difference, its just a string containing
1912
special characters or not.
1913
1914
Well, besides this "main stream", there are I. They
1915
flag the I or I of a certain logical entity - this
1916
means a whole document, a paragraph or a formatting like italicising. Almost
1917
every entity is embedded into a start I a completion directive - except
1918
of simple tokens.
1919
1920
In the current implementation, a directive is a reference to an array of mostly
1921
two fields: a directive constant showing which entity is related, and a start
1922
or completion hint which is a constant, too. The used constants are declared in
1923
B. Directives can pass additional informations by additional
1924
fields. By now, the headline directives use this feature to show the headline
1925
level, as well as the tag ones to provide tag type information and the document ones
1926
to keep the name of the original document. Further more, ordered list points I
1927
request a fix number this way.
1928
1929
# this example shows a tag directive
1930
... [DIRECTIVE_TAG, DIRECTIVE_START, "I"]
1931
+ "formatted" + " " + "strings"
1932
+ [DIRECTIVE_TAG, DIRECTIVE_COMPLETE, "I"] ...
1933
1934
To recognize whether a token is a basic or a directive, the ref() function can be
1935
used. However, this handling should be done by B transparently.
1936
The format may be subject to changes and is documented for information purposes only.
1937
1938
Original line numbers are no part of the stream but can be provided by embedded
1939
directives on request, see below for details.
1940
1941
This is the complete generator format. It is designed to be simple but powerful.
1942
1943
1944
=head1 METHODS
1945
1946
=head2 new()
1947
1948
The constructor builds and prepares a new parser object.
1949
1950
B
1951
1952
=over 4
1953
1954
=item The class name.
1955
1956
=back
1957
1958
B
1959
The new object in case of success.
1960
1961
B
1962
1963
my ($parser)=new PerlPoint::Parser;
1964
1965
=cut
1966
1967
# = CODE SECTION ========================================================================
1968
1969
# startup actions
1970
BEGIN
1971
{
1972
# declare startup helper function
1973
sub _startupGenerateConstants
1974
{
1975
# init counter
1976
my $c=0;
1977
1978
# and generate constants
1979
foreach my $constant (@_)
1980
{eval "use constant $constant => $c"; $c++;}
1981
}
1982
1983
# declare internal constants: action timeout types (used as array indices, sort alphabetically!)
1984
_startupGenerateConstants(
1985
'LEXER_TOKEN', # reply symbols token;
1986
'LEXER_FATAL', # bug: unexpected symbol;
1987
'LEXER_IGNORE', # ignore this symbol;
1988
'LEXER_EMPTYLINE', # reply the token "Empty_line";
1989
'LEXER_SPACE', # reply the token "Space" and a simple whitespace;
1990
);
1991
1992
# state constants
1993
_startupGenerateConstants(
1994
'STATE_DEFAULT', # default;
1995
'STATE_DEFAULT_TAGMODE', # default in tag mode;
1996
1997
'STATE_BLOCK', # block;
1998
'STATE_COMMENT', # comment;
1999
'STATE_CONTROL', # control paragraph (of a single character);
2000
'STATE_DPOINT', # definition list point;
2001
'STATE_DPOINT_ITEM', # definition list point item (defined stuff);
2002
'STATE_EMBEDDING', # embedded things (HTML, Perl, ...);
2003
'STATE_PFILTER', # paragraph filter installation;
2004
'STATE_PFILTERED', # "default" state after a pfilter installation;
2005
'STATE_CONDITION', # condition;
2006
'STATE_HEADLINE_LEVEL', # headline level setting;
2007
'STATE_HEADLINE', # headline;
2008
'STATE_OPOINT', # ordered list point;
2009
'STATE_TEXT', # text;
2010
'STATE_UPOINT', # unordered list point;
2011
'STATE_VERBATIM', # verbatim block;
2012
'STATE_TABLE', # table *paragraph*;
2013
'STATE_DEFINITION', # macro definition;
2014
);
2015
2016
# declare internal constants: list shifters
2017
_startupGenerateConstants(
2018
'LIST_SHIFT_RIGHT', # shift right;
2019
'LIST_SHIFT_LEFT', # shift left;
2020
);
2021
2022
# release memory
2023
undef &_startupGenerateConstants;
2024
}
2025
2026
# requires modern perl
2027
require 5.00503;
2028
2029
# declare module version
2030
$PerlPoint::Parser::VERSION=0.451;
2031
$PerlPoint::Parser::VERSION=$PerlPoint::Parser::VERSION; # to suppress a warning of exclusive usage only;
2032
2033
# pragmata
2034
use strict;
2035
2036
# load modules
2037
use Carp;
2038
# use Memoize;
2039
use IO::File;
2040
use File::Basename;
2041
use File::Spec::Functions;
2042
use File::Temp qw(tempfile);
2043
use PerlPoint::Anchors 0.03;
2044
use PerlPoint::Backend 0.10;
2045
use Cwd qw(:DEFAULT abs_path);
2046
use Digest::SHA1 qw(sha1_base64);
2047
use Storable qw(:DEFAULT dclone nfreeze);
2048
use PerlPoint::Constants 0.19 qw(:DEFAULT :parsing :stream :tags);
2049
2050
# memoizations
2051
2052
# startup declarations
2053
my (
2054
%data, # the collected declaration data;
2055
%lineNrs, # the lexers line number hash, input handle specific;
2056
%specials, # special character control (may be active or not);
2057
%lexerFlags, # lexer state flags;
2058
%lexerFlagsOfPreviousState, # buffered lexer state flags of previous state;
2059
%statistics, # statistics data;
2060
%variables, # user managed variables;
2061
%flags, # various flags;
2062
%macros, # macros / aliases;
2063
%openedSourcefiles, # a hash of all source files already opened (to enable smart inclusion);
2064
%paragraphTypeStrings, # paragraph type to string translation table;
2065
2066
@nestedSourcefiles, # a list of current source file nesting (to avoid circular inclusions);
2067
@specialStack, # special state stack for temporary activations (to restore original states);
2068
@stateStack, # state stack (mostly intended for non paragraph states like STATE_EMBEDDED);
2069
@tableSeparatorStack, # the first element is the column separator string within a table, empty otherwise;
2070
@inputStack, # a stack of additional input lines and dynamically inserted parts;
2071
@inHandles, # a stack of input handles (to manage nested sources);
2072
@olistLevels, # a hint storing the last recent ordered list level number of a paragraph (hyrarchically);
2073
@inLine, # current *real* input line (the unexpanded line read from a source file);
2074
@previousStackLines, # buffer of the last lines gotten from input stack;
2075
@libraryPath, # a collection of pathes to find files for \INCLUDE in;
2076
@headlineIds, # the hierarchical values of $directiveCounter pointing to the current chapter headline;
2077
2078
$anchors, # anchor collector object;
2079
$safeObject, # an object of class Safe to evaluate Perl code embedded into PerlPoint;
2080
$sourceFile, # the source file currently read;
2081
$tagsRef, # reference to a hash of valid tag openers (strings without the "<");
2082
$resultStreamRef, # reference to a data structure to put generated stream data in;
2083
$inHandle, # the data input stream (to parse);
2084
$parserState, # the current parser state;
2085
$readCompletely, # the input file is read completely;
2086
$_semerr, # semantic error counter;
2087
$tableColumns, # counter of completed table columns;
2088
$checksums, # paragraph checksums (and associated stream parts);
2089
$macroChecksum, # the current macro checksum;
2090
$varChecksum, # the current user variables checksum;
2091
$pendingTags, # list of tags to be finished after parsing (collected using a structure);
2092
$directiveCounter, # directive counter (just to mark stream directive pairs uniquely);
2093
$retranslator, # a backend object used to restore paragraph sources to be filtered;
2094
$retranslationBuffer, # buffer used in retranslation (needs to b global to avoid closure effects with lexicals in translator routines);
2095
);
2096
2097
# ----- Startup code begins here. -----
2098
2099
# prepare main input handle (obsolete when all people will use perl 5.6)
2100
$inHandle=new IO::File;
2101
2102
# set developer data
2103
my ($developerName, $developer)=('J. Stenzel', 'perl@jochen-stenzel.de');
2104
2105
# init flag
2106
$readCompletely=0;
2107
2108
# prepare a common pattern
2109
my $patternWUmlauts=qr/[\wäöüÄÖÜß]+/;
2110
2111
# prepare lexer patterns
2112
my $patternNlbBackslash=qr/(?
2113
my %lexerPatterns=(
2114
tag => qr/$patternNlbBackslash\\([A-Z_0-9]+)/,
2115
space => qr/(\s+)/,
2116
pfilterDelimiter => qr/$patternNlbBackslash((\|){1,2})/,
2117
table => qr/$patternNlbBackslash\\(TABLE)/,
2118
endTable => qr/$patternNlbBackslash\\(END_TABLE)/,
2119
embed => qr/$patternNlbBackslash\\(EMBED)/,
2120
endEmbed => qr/$patternNlbBackslash\\(END_EMBED)/,
2121
include => qr/$patternNlbBackslash\\(INCLUDE)/,
2122
nonWhitespace => qr/$patternNlbBackslash(\S)/,
2123
colon => qr/$patternNlbBackslash(:)/,
2124
namedVarKernel => qr/\$($patternWUmlauts)/,
2125
symVarKernel => qr/\$({($patternWUmlauts)})/,
2126
);
2127
@lexerPatterns{qw(
2128
namedVar
2129
symVar
2130
)
2131
}=(
2132
qr/$patternNlbBackslash$lexerPatterns{namedVarKernel}/,
2133
qr/$patternNlbBackslash$lexerPatterns{symVarKernel}/,
2134
);
2135
2136
# declare paragraphs which are embedded
2137
my %embeddedParagraphs;
2138
@embeddedParagraphs{
2139
DIRECTIVE_UPOINT,
2140
DIRECTIVE_OPOINT,
2141
}=();
2142
2143
# declare token descriptions (to be used in error messages)
2144
my %tokenDescriptions=(
2145
EOL => 'a carriage return',
2146
Embed => 'embedded code',
2147
Embedded => 'an \END_EMBED tag',
2148
Empty_line => 'an empty line',
2149
Heredoc_close => 'a string closing the "here document"',
2150
Heredoc_open => 'a "here document" opener',
2151
Ils => 'a indentation',
2152
Include => 'an included part',
2153
Named_variable => 'a named variable',
2154
Space => 'a whitespace',
2155
StreamedPart => undef,
2156
Symbolic_variable => 'a symbolic variable',
2157
Table => 'a table',
2158
Table_separator => 'a table column separator',
2159
Tabled => 'an \END_TABLE tag',
2160
Tag_name => 'a tag name',
2161
Word => 'a word',
2162
NoToken => 'an internal dummy token that is finally ignored',
2163
);
2164
2165
2166
2167
sub new {
2168
my($class)=shift;
2169
ref($class)
2170
and $class=ref($class);
2171
2172
my($self)=$class->SUPER::new( yyversion => '1.05',
2173
yystates =>
2174
[
2175
{#State 0
2176
ACTIONS => {
2177
'Paragraph_cache_hit' => 11,
2178
"||" => 4,
2179
'Empty_line' => 3,
2180
"+" => 5,
2181
"?" => 2
2182
},
2183
DEFAULT => -3,
2184
GOTOS => {
2185
'non_filterable_paragraph' => 1,
2186
'document' => 6,
2187
'restored_paragraph' => 7,
2188
'alias_definition' => 8,
2189
'built_paragraph' => 9,
2190
'optional_paragraph_filter' => 10,
2191
'condition' => 12,
2192
'paragraph' => 13
2193
}
2194
},
2195
{#State 1
2196
DEFAULT => -12
2197
},
2198
{#State 2
2199
DEFAULT => -33,
2200
GOTOS => {
2201
'@4-1' => 14
2202
}
2203
},
2204
{#State 3
2205
DEFAULT => -22
2206
},
2207
{#State 4
2208
DEFAULT => -4,
2209
GOTOS => {
2210
'@1-1' => 15
2211
}
2212
},
2213
{#State 5
2214
DEFAULT => -152,
2215
GOTOS => {
2216
'@31-1' => 16
2217
}
2218
},
2219
{#State 6
2220
ACTIONS => {
2221
'' => 17,
2222
'Paragraph_cache_hit' => 11,
2223
"||" => 4,
2224
'Empty_line' => 3,
2225
"+" => 5,
2226
"?" => 2
2227
},
2228
DEFAULT => -3,
2229
GOTOS => {
2230
'non_filterable_paragraph' => 1,
2231
'built_paragraph' => 9,
2232
'optional_paragraph_filter' => 10,
2233
'restored_paragraph' => 7,
2234
'paragraph' => 18,
2235
'condition' => 12,
2236
'alias_definition' => 8
2237
}
2238
},
2239
{#State 7
2240
DEFAULT => -9
2241
},
2242
{#State 8
2243
DEFAULT => -24
2244
},
2245
{#State 9
2246
DEFAULT => -8
2247
},
2248
{#State 10
2249
DEFAULT => -10,
2250
GOTOS => {
2251
'@2-1' => 19
2252
}
2253
},
2254
{#State 11
2255
DEFAULT => -25
2256
},
2257
{#State 12
2258
DEFAULT => -23
2259
},
2260
{#State 13
2261
DEFAULT => -1
2262
},
2263
{#State 14
2264
ACTIONS => {
2265
'Embed' => 30,
2266
'Named_variable' => 21,
2267
'Table_separator' => 32,
2268
'Tag_name' => 34,
2269
'Symbolic_variable' => 33,
2270
'Table' => 37,
2271
'Include' => 36,
2272
'Space' => 23,
2273
'Word' => 27,
2274
'StreamedPart' => 28
2275
},
2276
GOTOS => {
2277
'basic' => 20,
2278
'basics' => 29,
2279
'embedded' => 31,
2280
'table_separator' => 25,
2281
'included' => 24,
2282
'table' => 22,
2283
'tag' => 26,
2284
'element' => 35
2285
}
2286
},
2287
{#State 15
2288
ACTIONS => {
2289
'Word' => 38
2290
},
2291
GOTOS => {
2292
'paragraph_filters' => 39
2293
}
2294
},
2295
{#State 16
2296
ACTIONS => {
2297
'Word' => 40
2298
}
2299
},
2300
{#State 17
2301
DEFAULT => 0
2302
},
2303
{#State 18
2304
DEFAULT => -2
2305
},
2306
{#State 19
2307
ACTIONS => {
2308
'Colon' => 41,
2309
'Named_variable' => 61,
2310
"\@" => 42,
2311
'Upoint_cache_hit' => 62,
2312
"~" => 43,
2313
'Dpoint_cache_hit' => 44,
2314
'Space' => 23,
2315
"*" => 47,
2316
'Word' => 27,
2317
'EOL' => 67,
2318
'StreamedPart' => 28,
2319
'Opoint_cache_hit' => 70,
2320
'Embed' => 30,
2321
'Table_separator' => 32,
2322
'Ils' => 52,
2323
'Block_cache_hit' => 73,
2324
"/" => 71,
2325
'Symbolic_variable' => 33,
2326
'Tag_name' => 34,
2327
"=" => 74,
2328
'Headline_cache_hit' => 53,
2329
'Table' => 37,
2330
'Include' => 36,
2331
"#" => 78,
2332
'Heredoc_open' => 81,
2333
"." => 57
2334
},
2335
GOTOS => {
2336
'basic' => 58,
2337
'dlist' => 60,
2338
'verbatim' => 59,
2339
'table' => 22,
2340
'dlist_opener' => 63,
2341
'upoint' => 45,
2342
'literal' => 46,
2343
'olist' => 64,
2344
'ulist' => 65,
2345
'text' => 66,
2346
'opoint_opener' => 48,
2347
'included' => 24,
2348
'table_separator' => 25,
2349
'tag' => 26,
2350
'optionally_dotted_text' => 68,
2351
'headline_level' => 49,
2352
'list' => 50,
2353
'dstream_entrypoint' => 69,
2354
'compound_block' => 51,
2355
'embedded' => 31,
2356
'variable_assignment' => 72,
2357
'element' => 35,
2358
'dotted_text' => 54,
2359
'opoint' => 55,
2360
'table_paragraph' => 75,
2361
'comment' => 76,
2362
'dpoint' => 56,
2363
'original_paragraph' => 77,
2364
'list_part' => 79,
2365
'block' => 80,
2366
'headline' => 82
2367
}
2368
},
2369
{#State 20
2370
DEFAULT => -101
2371
},
2372
{#State 21
2373
DEFAULT => -110
2374
},
2375
{#State 22
2376
DEFAULT => -104
2377
},
2378
{#State 23
2379
DEFAULT => -109
2380
},
2381
{#State 24
2382
DEFAULT => -115
2383
},
2384
{#State 25
2385
DEFAULT => -105
2386
},
2387
{#State 26
2388
DEFAULT => -113
2389
},
2390
{#State 27
2391
DEFAULT => -108
2392
},
2393
{#State 28
2394
DEFAULT => -112
2395
},
2396
{#State 29
2397
ACTIONS => {
2398
'Embed' => 30,
2399
'Empty_line' => 84,
2400
'Named_variable' => 21,
2401
'Table_separator' => 32,
2402
'Symbolic_variable' => 33,
2403
'Tag_name' => 34,
2404
'Table' => 37,
2405
'Include' => 36,
2406
'Space' => 23,
2407
'Word' => 27,
2408
'StreamedPart' => 28
2409
},
2410
GOTOS => {
2411
'basic' => 83,
2412
'embedded' => 31,
2413
'included' => 24,
2414
'table_separator' => 25,
2415
'table' => 22,
2416
'tag' => 26,
2417
'element' => 35
2418
}
2419
},
2420
{#State 30
2421
DEFAULT => -147,
2422
GOTOS => {
2423
'@28-1' => 85
2424
}
2425
},
2426
{#State 31
2427
DEFAULT => -114
2428
},
2429
{#State 32
2430
DEFAULT => -143
2431
},
2432
{#State 33
2433
DEFAULT => -111
2434
},
2435
{#State 34
2436
DEFAULT => -124,
2437
GOTOS => {
2438
'@19-1' => 86
2439
}
2440
},
2441
{#State 35
2442
DEFAULT => -103
2443
},
2444
{#State 36
2445
DEFAULT => -150,
2446
GOTOS => {
2447
'@30-1' => 87
2448
}
2449
},
2450
{#State 37
2451
DEFAULT => -140,
2452
GOTOS => {
2453
'@24-1' => 88
2454
}
2455
},
2456
{#State 38
2457
DEFAULT => -6
2458
},
2459
{#State 39
2460
ACTIONS => {
2461
"|" => 90,
2462
"||" => 89
2463
}
2464
},
2465
{#State 40
2466
DEFAULT => -153,
2467
GOTOS => {
2468
'@32-3' => 91
2469
}
2470
},
2471
{#State 41
2472
DEFAULT => -58,
2473
GOTOS => {
2474
'@8-1' => 92
2475
}
2476
},
2477
{#State 42
2478
DEFAULT => -144,
2479
GOTOS => {
2480
'@26-1' => 93
2481
}
2482
},
2483
{#State 43
2484
DEFAULT => -80,
2485
GOTOS => {
2486
'@16-1' => 94
2487
}
2488
},
2489
{#State 44
2490
DEFAULT => -57
2491
},
2492
{#State 45
2493
DEFAULT => -43
2494
},
2495
{#State 46
2496
DEFAULT => -70,
2497
GOTOS => {
2498
'@11-1' => 95
2499
}
2500
},
2501
{#State 47
2502
DEFAULT => -52,
2503
GOTOS => {
2504
'@6-1' => 96
2505
}
2506
},
2507
{#State 48
2508
DEFAULT => -47,
2509
GOTOS => {
2510
'@5-1' => 97
2511
}
2512
},
2513
{#State 49
2514
ACTIONS => {
2515
"=" => 99
2516
},
2517
DEFAULT => -26,
2518
GOTOS => {
2519
'@3-1' => 98
2520
}
2521
},
2522
{#State 50
2523
ACTIONS => {
2524
'Colon' => 41,
2525
"<" => 100,
2526
'Dpoint_cache_hit' => 44,
2527
"*" => 47,
2528
">" => 102,
2529
'Upoint_cache_hit' => 62,
2530
'Opoint_cache_hit' => 70,
2531
"#" => 78
2532
},
2533
DEFAULT => -20,
2534
GOTOS => {
2535
'list_shifter' => 103,
2536
'dlist' => 60,
2537
'list_shift' => 101,
2538
'dlist_opener' => 63,
2539
'upoint' => 45,
2540
'opoint' => 55,
2541
'olist' => 64,
2542
'ulist' => 65,
2543
'dpoint' => 56,
2544
'opoint_opener' => 48,
2545
'list_part' => 104
2546
}
2547
},
2548
{#State 51
2549
ACTIONS => {
2550
"-" => 105,
2551
'Ils' => 52,
2552
'Block_cache_hit' => 73
2553
},
2554
DEFAULT => -19,
2555
GOTOS => {
2556
'block_flagnew' => 106,
2557
'block' => 107
2558
}
2559
},
2560
{#State 52
2561
DEFAULT => -65,
2562
GOTOS => {
2563
'@10-1' => 108
2564
}
2565
},
2566
{#State 53
2567
DEFAULT => -28
2568
},
2569
{#State 54
2570
DEFAULT => -69
2571
},
2572
{#State 55
2573
DEFAULT => -41
2574
},
2575
{#State 56
2576
DEFAULT => -45
2577
},
2578
{#State 57
2579
DEFAULT => -72,
2580
GOTOS => {
2581
'@12-1' => 109
2582
}
2583
},
2584
{#State 58
2585
DEFAULT => -97
2586
},
2587
{#State 59
2588
DEFAULT => -15
2589
},
2590
{#State 60
2591
ACTIONS => {
2592
'Colon' => 41,
2593
'Dpoint_cache_hit' => 44
2594
},
2595
DEFAULT => -40,
2596
GOTOS => {
2597
'dpoint' => 110,
2598
'dlist_opener' => 63
2599
}
2600
},
2601
{#State 61
2602
ACTIONS => {
2603
"=" => 111
2604
},
2605
DEFAULT => -110
2606
},
2607
{#State 62
2608
DEFAULT => -54
2609
},
2610
{#State 63
2611
DEFAULT => -55,
2612
GOTOS => {
2613
'@7-1' => 112
2614
}
2615
},
2616
{#State 64
2617
ACTIONS => {
2618
'Opoint_cache_hit' => 70,
2619
"#" => 78
2620
},
2621
DEFAULT => -38,
2622
GOTOS => {
2623
'opoint' => 113,
2624
'opoint_opener' => 48
2625
}
2626
},
2627
{#State 65
2628
ACTIONS => {
2629
"*" => 47,
2630
'Upoint_cache_hit' => 62
2631
},
2632
DEFAULT => -39,
2633
GOTOS => {
2634
'upoint' => 114
2635
}
2636
},
2637
{#State 66
2638
DEFAULT => -68
2639
},
2640
{#State 67
2641
DEFAULT => -98
2642
},
2643
{#State 68
2644
DEFAULT => -14
2645
},
2646
{#State 69
2647
DEFAULT => -17
2648
},
2649
{#State 70
2650
DEFAULT => -49
2651
},
2652
{#State 71
2653
ACTIONS => {
2654
"/" => 115
2655
}
2656
},
2657
{#State 72
2658
DEFAULT => -21
2659
},
2660
{#State 73
2661
DEFAULT => -67
2662
},
2663
{#State 74
2664
DEFAULT => -29
2665
},
2666
{#State 75
2667
DEFAULT => -18
2668
},
2669
{#State 76
2670
DEFAULT => -16
2671
},
2672
{#State 77
2673
DEFAULT => -11
2674
},
2675
{#State 78
2676
ACTIONS => {
2677
"#" => 116
2678
},
2679
DEFAULT => -50
2680
},
2681
{#State 79
2682
DEFAULT => -35
2683
},
2684
{#State 80
2685
DEFAULT => -60
2686
},
2687
{#State 81
2688
DEFAULT => -74,
2689
GOTOS => {
2690
'@13-1' => 117
2691
}
2692
},
2693
{#State 82
2694
DEFAULT => -13
2695
},
2696
{#State 83
2697
DEFAULT => -102
2698
},
2699
{#State 84
2700
DEFAULT => -34
2701
},
2702
{#State 85
2703
ACTIONS => {
2704
"{" => 119
2705
},
2706
GOTOS => {
2707
'used_tagpars' => 118
2708
}
2709
},
2710
{#State 86
2711
ACTIONS => {
2712
"{" => 119
2713
},
2714
DEFAULT => -127,
2715
GOTOS => {
2716
'used_tagpars' => 120,
2717
'optional_tagpars' => 121
2718
}
2719
},
2720
{#State 87
2721
ACTIONS => {
2722
"{" => 119
2723
},
2724
GOTOS => {
2725
'used_tagpars' => 122
2726
}
2727
},
2728
{#State 88
2729
ACTIONS => {
2730
"{" => 119
2731
},
2732
GOTOS => {
2733
'used_tagpars' => 123
2734
}
2735
},
2736
{#State 89
2737
DEFAULT => -5
2738
},
2739
{#State 90
2740
ACTIONS => {
2741
'Word' => 124
2742
}
2743
},
2744
{#State 91
2745
ACTIONS => {
2746
"{" => 119
2747
},
2748
DEFAULT => -127,
2749
GOTOS => {
2750
'used_tagpars' => 120,
2751
'optional_tagpars' => 125
2752
}
2753
},
2754
{#State 92
2755
ACTIONS => {
2756
'Embed' => 30,
2757
'Named_variable' => 21,
2758
'Symbolic_variable' => 33,
2759
'Tag_name' => 34,
2760
'Space' => 23,
2761
'Include' => 36,
2762
'Word' => 27,
2763
'StreamedPart' => 28
2764
},
2765
GOTOS => {
2766
'elements' => 126,
2767
'embedded' => 31,
2768
'included' => 24,
2769
'tag' => 26,
2770
'element' => 127
2771
}
2772
},
2773
{#State 93
2774
ACTIONS => {
2775
'Word' => 128
2776
},
2777
GOTOS => {
2778
'words' => 129
2779
}
2780
},
2781
{#State 94
2782
ACTIONS => {
2783
'Word' => 128
2784
},
2785
GOTOS => {
2786
'words' => 130
2787
}
2788
},
2789
{#State 95
2790
ACTIONS => {
2791
'Embed' => 30,
2792
'Named_variable' => 21,
2793
'Table_separator' => 32,
2794
'Symbolic_variable' => 33,
2795
'Tag_name' => 34,
2796
'Table' => 37,
2797
'Include' => 36,
2798
'Space' => 23,
2799
'Word' => 27,
2800
'EOL' => 67,
2801
'StreamedPart' => 28
2802
},
2803
DEFAULT => -87,
2804
GOTOS => {
2805
'basic' => 58,
2806
'embedded' => 31,
2807
'table' => 22,
2808
'literals' => 131,
2809
'element' => 35,
2810
'literal' => 132,
2811
'included' => 24,
2812
'table_separator' => 25,
2813
'tag' => 26,
2814
'optional_literals' => 133
2815
}
2816
},
2817
{#State 96
2818
ACTIONS => {
2819
'Embed' => 30,
2820
'Named_variable' => 21,
2821
'Table_separator' => 32,
2822
'Symbolic_variable' => 33,
2823
'Tag_name' => 34,
2824
'Table' => 37,
2825
'Include' => 36,
2826
'Space' => 23,
2827
'Word' => 27,
2828
'EOL' => 67,
2829
'StreamedPart' => 28
2830
},
2831
GOTOS => {
2832
'basic' => 58,
2833
'embedded' => 31,
2834
'table' => 22,
2835
'element' => 35,
2836
'literal' => 46,
2837
'text' => 134,
2838
'table_separator' => 25,
2839
'included' => 24,
2840
'tag' => 26
2841
}
2842
},
2843
{#State 97
2844
ACTIONS => {
2845
'Embed' => 30,
2846
'Named_variable' => 21,
2847
'Table_separator' => 32,
2848
'Symbolic_variable' => 33,
2849
'Tag_name' => 34,
2850
'Table' => 37,
2851
'Include' => 36,
2852
'Space' => 23,
2853
'Word' => 27,
2854
'EOL' => 67,
2855
'StreamedPart' => 28
2856
},
2857
GOTOS => {
2858
'basic' => 58,
2859
'embedded' => 31,
2860
'table' => 22,
2861
'element' => 35,
2862
'literal' => 46,
2863
'text' => 135,
2864
'table_separator' => 25,
2865
'included' => 24,
2866
'tag' => 26
2867
}
2868
},
2869
{#State 98
2870
ACTIONS => {
2871
'Embed' => 30,
2872
'Named_variable' => 21,
2873
'Table_separator' => 32,
2874
'Symbolic_variable' => 33,
2875
'Tag_name' => 34,
2876
'Table' => 37,
2877
'Include' => 36,
2878
'Space' => 23,
2879
'Word' => 27,
2880
'StreamedPart' => 28
2881
},
2882
GOTOS => {
2883
'basic' => 20,
2884
'basics' => 136,
2885
'embedded' => 31,
2886
'table' => 22,
2887
'element' => 35,
2888
'table_separator' => 25,
2889
'included' => 24,
2890
'tag' => 26
2891
}
2892
},
2893
{#State 99
2894
DEFAULT => -30
2895
},
2896
{#State 100
2897
DEFAULT => -86
2898
},
2899
{#State 101
2900
ACTIONS => {
2901
'Opoint_cache_hit' => 70,
2902
'Colon' => 41,
2903
"*" => 47,
2904
"#" => 78,
2905
'Upoint_cache_hit' => 62,
2906
'Dpoint_cache_hit' => 44
2907
},
2908
GOTOS => {
2909
'dlist' => 60,
2910
'dlist_opener' => 63,
2911
'upoint' => 45,
2912
'opoint' => 55,
2913
'olist' => 64,
2914
'dpoint' => 56,
2915
'ulist' => 65,
2916
'opoint_opener' => 48,
2917
'list_part' => 137
2918
}
2919
},
2920
{#State 102
2921
DEFAULT => -85
2922
},
2923
{#State 103
2924
DEFAULT => -82,
2925
GOTOS => {
2926
'@17-1' => 138
2927
}
2928
},
2929
{#State 104
2930
DEFAULT => -36
2931
},
2932
{#State 105
2933
DEFAULT => -63,
2934
GOTOS => {
2935
'@9-1' => 139
2936
}
2937
},
2938
{#State 106
2939
ACTIONS => {
2940
'Ils' => 52,
2941
'Block_cache_hit' => 73
2942
},
2943
GOTOS => {
2944
'compound_block' => 140,
2945
'block' => 80
2946
}
2947
},
2948
{#State 107
2949
DEFAULT => -61
2950
},
2951
{#State 108
2952
ACTIONS => {
2953
'Embed' => 30,
2954
'Named_variable' => 21,
2955
'Table_separator' => 32,
2956
'Symbolic_variable' => 33,
2957
'Tag_name' => 34,
2958
'Table' => 37,
2959
'Include' => 36,
2960
'Space' => 23,
2961
'Word' => 27,
2962
'EOL' => 67,
2963
'StreamedPart' => 28
2964
},
2965
GOTOS => {
2966
'basic' => 58,
2967
'embedded' => 31,
2968
'table' => 22,
2969
'element' => 35,
2970
'literal' => 46,
2971
'text' => 141,
2972
'table_separator' => 25,
2973
'included' => 24,
2974
'tag' => 26
2975
}
2976
},
2977
{#State 109
2978
ACTIONS => {
2979
'Embed' => 30,
2980
'Named_variable' => 21,
2981
'Table_separator' => 32,
2982
'Symbolic_variable' => 33,
2983
'Tag_name' => 34,
2984
'Table' => 37,
2985
'Include' => 36,
2986
'Space' => 23,
2987
'Word' => 27,
2988
'EOL' => 67,
2989
'StreamedPart' => 28
2990
},
2991
GOTOS => {
2992
'basic' => 58,
2993
'embedded' => 31,
2994
'table' => 22,
2995
'element' => 35,
2996
'literal' => 46,
2997
'text' => 142,
2998
'table_separator' => 25,
2999
'included' => 24,
3000
'tag' => 26
3001
}
3002
},
3003
{#State 110
3004
DEFAULT => -46
3005
},
3006
{#State 111
3007
DEFAULT => -76,
3008
GOTOS => {
3009
'@14-2' => 143
3010
}
3011
},
3012
{#State 112
3013
ACTIONS => {
3014
'Embed' => 30,
3015
'Named_variable' => 21,
3016
'Table_separator' => 32,
3017
'Symbolic_variable' => 33,
3018
'Tag_name' => 34,
3019
'Table' => 37,
3020
'Include' => 36,
3021
'Space' => 23,
3022
'Word' => 27,
3023
'EOL' => 67,
3024
'StreamedPart' => 28
3025
},
3026
GOTOS => {
3027
'basic' => 58,
3028
'embedded' => 31,
3029
'table' => 22,
3030
'element' => 35,
3031
'literal' => 46,
3032
'text' => 144,
3033
'table_separator' => 25,
3034
'included' => 24,
3035
'tag' => 26
3036
}
3037
},
3038
{#State 113
3039
DEFAULT => -42
3040
},
3041
{#State 114
3042
DEFAULT => -44
3043
},
3044
{#State 115
3045
DEFAULT => -78,
3046
GOTOS => {
3047
'@15-2' => 145
3048
}
3049
},
3050
{#State 116
3051
DEFAULT => -51
3052
},
3053
{#State 117
3054
ACTIONS => {
3055
'Embed' => 30,
3056
'Empty_line' => 148,
3057
'Named_variable' => 21,
3058
'Table_separator' => 32,
3059
'Symbolic_variable' => 33,
3060
'Tag_name' => 34,
3061
'Table' => 37,
3062
'Include' => 36,
3063
'Space' => 23,
3064
'Word' => 27,
3065
'EOL' => 67,
3066
'StreamedPart' => 28
3067
},
3068
GOTOS => {
3069
'basic' => 58,
3070
'embedded' => 31,
3071
'table' => 22,
3072
'literal_or_empty_line' => 147,
3073
'element' => 35,
3074
'literal' => 146,
3075
'literals_and_empty_lines' => 149,
3076
'included' => 24,
3077
'table_separator' => 25,
3078
'tag' => 26
3079
}
3080
},
3081
{#State 118
3082
DEFAULT => -148,
3083
GOTOS => {
3084
'@29-3' => 150
3085
}
3086
},
3087
{#State 119
3088
ACTIONS => {
3089
'Word' => 152
3090
},
3091
GOTOS => {
3092
'tagpars' => 151,
3093
'tagpar' => 153
3094
}
3095
},
3096
{#State 120
3097
DEFAULT => -128
3098
},
3099
{#State 121
3100
DEFAULT => -125,
3101
GOTOS => {
3102
'@20-3' => 154
3103
}
3104
},
3105
{#State 122
3106
DEFAULT => -151
3107
},
3108
{#State 123
3109
DEFAULT => -141,
3110
GOTOS => {
3111
'@25-3' => 155
3112
}
3113
},
3114
{#State 124
3115
DEFAULT => -7
3116
},
3117
{#State 125
3118
DEFAULT => -154,
3119
GOTOS => {
3120
'@33-5' => 156
3121
}
3122
},
3123
{#State 126
3124
ACTIONS => {
3125
'Colon' => 157,
3126
'Embed' => 30,
3127
'Named_variable' => 21,
3128
'Symbolic_variable' => 33,
3129
'Tag_name' => 34,
3130
'Include' => 36,
3131
'Space' => 23,
3132
'Word' => 27,
3133
'StreamedPart' => 28
3134
},
3135
GOTOS => {
3136
'embedded' => 31,
3137
'included' => 24,
3138
'tag' => 26,
3139
'element' => 158
3140
}
3141
},
3142
{#State 127
3143
DEFAULT => -106
3144
},
3145
{#State 128
3146
DEFAULT => -118
3147
},
3148
{#State 129
3149
ACTIONS => {
3150
'Word' => 159,
3151
'EOL' => 160
3152
}
3153
},
3154
{#State 130
3155
ACTIONS => {
3156
'Empty_line' => 161,
3157
'Word' => 159
3158
}
3159
},
3160
{#State 131
3161
ACTIONS => {
3162
'Embed' => 30,
3163
'Named_variable' => 21,
3164
'Table_separator' => 32,
3165
'Symbolic_variable' => 33,
3166
'Tag_name' => 34,
3167
'Table' => 37,
3168
'Include' => 36,
3169
'Space' => 23,
3170
'Word' => 27,
3171
'EOL' => 67,
3172
'StreamedPart' => 28
3173
},
3174
DEFAULT => -88,
3175
GOTOS => {
3176
'basic' => 58,
3177
'embedded' => 31,
3178
'table' => 22,
3179
'element' => 35,
3180
'literal' => 162,
3181
'table_separator' => 25,
3182
'included' => 24,
3183
'tag' => 26
3184
}
3185
},
3186
{#State 132
3187
DEFAULT => -89
3188
},
3189
{#State 133
3190
ACTIONS => {
3191
'Empty_line' => 163
3192
}
3193
},
3194
{#State 134
3195
DEFAULT => -53
3196
},
3197
{#State 135
3198
DEFAULT => -48
3199
},
3200
{#State 136
3201
ACTIONS => {
3202
'Embed' => 30,
3203
'Named_variable' => 21,
3204
'Table_separator' => 32,
3205
"~" => 164,
3206
'Symbolic_variable' => 33,
3207
'Tag_name' => 34,
3208
'Table' => 37,
3209
'Include' => 36,
3210
'Space' => 23,
3211
'Word' => 27,
3212
'StreamedPart' => 28
3213
},
3214
DEFAULT => -31,
3215
GOTOS => {
3216
'basic' => 83,
3217
'embedded' => 31,
3218
'table' => 22,
3219
'element' => 35,
3220
'table_separator' => 25,
3221
'included' => 24,
3222
'optional_headline_shortcut' => 165,
3223
'tag' => 26
3224
}
3225
},
3226
{#State 137
3227
DEFAULT => -37
3228
},
3229
{#State 138
3230
ACTIONS => {
3231
'Number' => 166
3232
},
3233
DEFAULT => -116,
3234
GOTOS => {
3235
'optional_number' => 167
3236
}
3237
},
3238
{#State 139
3239
ACTIONS => {
3240
'Empty_line' => 168
3241
}
3242
},
3243
{#State 140
3244
ACTIONS => {
3245
"-" => 105,
3246
'Ils' => 52,
3247
'Block_cache_hit' => 73
3248
},
3249
DEFAULT => -62,
3250
GOTOS => {
3251
'block_flagnew' => 106,
3252
'block' => 107
3253
}
3254
},
3255
{#State 141
3256
DEFAULT => -66
3257
},
3258
{#State 142
3259
DEFAULT => -73
3260
},
3261
{#State 143
3262
ACTIONS => {
3263
'Embed' => 30,
3264
'Named_variable' => 21,
3265
'Table_separator' => 32,
3266
'Symbolic_variable' => 33,
3267
'Tag_name' => 34,
3268
'Table' => 37,
3269
'Include' => 36,
3270
'Space' => 23,
3271
'Word' => 27,
3272
'EOL' => 67,
3273
'StreamedPart' => 28
3274
},
3275
GOTOS => {
3276
'basic' => 58,
3277
'embedded' => 31,
3278
'table' => 22,
3279
'element' => 35,
3280
'literal' => 46,
3281
'text' => 169,
3282
'table_separator' => 25,
3283
'included' => 24,
3284
'tag' => 26
3285
}
3286
},
3287
{#State 144
3288
DEFAULT => -56
3289
},
3290
{#State 145
3291
ACTIONS => {
3292
'Embed' => 30,
3293
'Named_variable' => 21,
3294
'Table_separator' => 32,
3295
'Symbolic_variable' => 33,
3296
'Tag_name' => 34,
3297
'Table' => 37,
3298
'Include' => 36,
3299
'Space' => 23,
3300
'Word' => 27,
3301
'StreamedPart' => 28
3302
},
3303
DEFAULT => -99,
3304
GOTOS => {
3305
'basic' => 20,
3306
'basics' => 170,
3307
'embedded' => 31,
3308
'table' => 22,
3309
'element' => 35,
3310
'table_separator' => 25,
3311
'included' => 24,
3312
'tag' => 26,
3313
'optional_basics' => 171
3314
}
3315
},
3316
{#State 146
3317
DEFAULT => -95
3318
},
3319
{#State 147
3320
DEFAULT => -93
3321
},
3322
{#State 148
3323
DEFAULT => -96
3324
},
3325
{#State 149
3326
ACTIONS => {
3327
'Embed' => 30,
3328
'Empty_line' => 148,
3329
'Named_variable' => 21,
3330
'Table_separator' => 32,
3331
'Symbolic_variable' => 33,
3332
'Tag_name' => 34,
3333
'Table' => 37,
3334
'Include' => 36,
3335
'Space' => 23,
3336
'Word' => 27,
3337
'Heredoc_close' => 173,
3338
'EOL' => 67,
3339
'StreamedPart' => 28
3340
},
3341
GOTOS => {
3342
'basic' => 58,
3343
'embedded' => 31,
3344
'table' => 22,
3345
'literal_or_empty_line' => 172,
3346
'element' => 35,
3347
'literal' => 146,
3348
'included' => 24,
3349
'table_separator' => 25,
3350
'tag' => 26
3351
}
3352
},
3353
{#State 150
3354
ACTIONS => {
3355
'Embed' => 30,
3356
'Empty_line' => 148,
3357
'Named_variable' => 21,
3358
'Table_separator' => 32,
3359
'Symbolic_variable' => 33,
3360
'Tag_name' => 34,
3361
'Table' => 37,
3362
'Include' => 36,
3363
'Space' => 23,
3364
'Word' => 27,
3365
'EOL' => 67,
3366
'StreamedPart' => 28
3367
},
3368
DEFAULT => -91,
3369
GOTOS => {
3370
'basic' => 58,
3371
'embedded' => 31,
3372
'optional_literals_and_empty_lines' => 175,
3373
'table' => 22,
3374
'literal_or_empty_line' => 147,
3375
'element' => 35,
3376
'literal' => 146,
3377
'literals_and_empty_lines' => 174,
3378
'included' => 24,
3379
'table_separator' => 25,
3380
'tag' => 26
3381
}
3382
},
3383
{#State 151
3384
ACTIONS => {
3385
'Space' => 177,
3386
"}" => 176
3387
}
3388
},
3389
{#State 152
3390
DEFAULT => -132,
3391
GOTOS => {
3392
'@21-1' => 178
3393
}
3394
},
3395
{#State 153
3396
DEFAULT => -130
3397
},
3398
{#State 154
3399
ACTIONS => {
3400
"<" => 179
3401
},
3402
DEFAULT => -137,
3403
GOTOS => {
3404
'optional_tagbody' => 180
3405
}
3406
},
3407
{#State 155
3408
ACTIONS => {
3409
'Embed' => 30,
3410
'Empty_line' => 148,
3411
'Named_variable' => 21,
3412
'Table_separator' => 32,
3413
'Symbolic_variable' => 33,
3414
'Tag_name' => 34,
3415
'Table' => 37,
3416
'Include' => 36,
3417
'Space' => 23,
3418
'Word' => 27,
3419
'EOL' => 67,
3420
'StreamedPart' => 28
3421
},
3422
DEFAULT => -91,
3423
GOTOS => {
3424
'basic' => 58,
3425
'embedded' => 31,
3426
'optional_literals_and_empty_lines' => 181,
3427
'table' => 22,
3428
'literal_or_empty_line' => 147,
3429
'element' => 35,
3430
'literal' => 146,
3431
'literals_and_empty_lines' => 174,
3432
'included' => 24,
3433
'table_separator' => 25,
3434
'tag' => 26
3435
}
3436
},
3437
{#State 156
3438
ACTIONS => {
3439
'Colon' => 182
3440
}
3441
},
3442
{#State 157
3443
DEFAULT => -59
3444
},
3445
{#State 158
3446
DEFAULT => -107
3447
},
3448
{#State 159
3449
DEFAULT => -119
3450
},
3451
{#State 160
3452
DEFAULT => -145,
3453
GOTOS => {
3454
'@27-4' => 183
3455
}
3456
},
3457
{#State 161
3458
DEFAULT => -81
3459
},
3460
{#State 162
3461
DEFAULT => -90
3462
},
3463
{#State 163
3464
DEFAULT => -71
3465
},
3466
{#State 164
3467
ACTIONS => {
3468
'Space' => 185,
3469
'Word' => 187
3470
},
3471
GOTOS => {
3472
'words_or_spaces' => 186,
3473
'word_or_space' => 184
3474
}
3475
},
3476
{#State 165
3477
ACTIONS => {
3478
'Empty_line' => 188
3479
}
3480
},
3481
{#State 166
3482
DEFAULT => -117
3483
},
3484
{#State 167
3485
DEFAULT => -83,
3486
GOTOS => {
3487
'@18-3' => 189
3488
}
3489
},
3490
{#State 168
3491
DEFAULT => -64
3492
},
3493
{#State 169
3494
DEFAULT => -77
3495
},
3496
{#State 170
3497
ACTIONS => {
3498
'Embed' => 30,
3499
'Named_variable' => 21,
3500
'Table_separator' => 32,
3501
'Symbolic_variable' => 33,
3502
'Tag_name' => 34,
3503
'Table' => 37,
3504
'Include' => 36,
3505
'Space' => 23,
3506
'Word' => 27,
3507
'StreamedPart' => 28
3508
},
3509
DEFAULT => -100,
3510
GOTOS => {
3511
'basic' => 83,
3512
'embedded' => 31,
3513
'included' => 24,
3514
'table_separator' => 25,
3515
'table' => 22,
3516
'tag' => 26,
3517
'element' => 35
3518
}
3519
},
3520
{#State 171
3521
ACTIONS => {
3522
'Empty_line' => 190
3523
}
3524
},
3525
{#State 172
3526
DEFAULT => -94
3527
},
3528
{#State 173
3529
DEFAULT => -75
3530
},
3531
{#State 174
3532
ACTIONS => {
3533
'Embed' => 30,
3534
'Empty_line' => 148,
3535
'Named_variable' => 21,
3536
'Table_separator' => 32,
3537
'Symbolic_variable' => 33,
3538
'Tag_name' => 34,
3539
'Table' => 37,
3540
'Include' => 36,
3541
'Space' => 23,
3542
'Word' => 27,
3543
'EOL' => 67,
3544
'StreamedPart' => 28
3545
},
3546
DEFAULT => -92,
3547
GOTOS => {
3548
'basic' => 58,
3549
'embedded' => 31,
3550
'table' => 22,
3551
'literal_or_empty_line' => 172,
3552
'element' => 35,
3553
'literal' => 146,
3554
'included' => 24,
3555
'table_separator' => 25,
3556
'tag' => 26
3557
}
3558
},
3559
{#State 175
3560
ACTIONS => {
3561
'Embedded' => 191
3562
}
3563
},
3564
{#State 176
3565
DEFAULT => -129
3566
},
3567
{#State 177
3568
ACTIONS => {
3569
'Word' => 152
3570
},
3571
GOTOS => {
3572
'tagpar' => 192
3573
}
3574
},
3575
{#State 178
3576
ACTIONS => {
3577
"=" => 193
3578
}
3579
},
3580
{#State 179
3581
DEFAULT => -138,
3582
GOTOS => {
3583
'@23-1' => 194
3584
}
3585
},
3586
{#State 180
3587
DEFAULT => -126
3588
},
3589
{#State 181
3590
ACTIONS => {
3591
'Tabled' => 195
3592
}
3593
},
3594
{#State 182
3595
DEFAULT => -155,
3596
GOTOS => {
3597
'@34-7' => 196
3598
}
3599
},
3600
{#State 183
3601
ACTIONS => {
3602
'Embed' => 30,
3603
'Named_variable' => 21,
3604
'Table_separator' => 32,
3605
'Symbolic_variable' => 33,
3606
'Tag_name' => 34,
3607
'Table' => 37,
3608
'Include' => 36,
3609
'Space' => 23,
3610
'Word' => 27,
3611
'EOL' => 67,
3612
'StreamedPart' => 28
3613
},
3614
DEFAULT => -87,
3615
GOTOS => {
3616
'basic' => 58,
3617
'embedded' => 31,
3618
'table' => 22,
3619
'literals' => 131,
3620
'element' => 35,
3621
'literal' => 132,
3622
'included' => 24,
3623
'table_separator' => 25,
3624
'tag' => 26,
3625
'optional_literals' => 197
3626
}
3627
},
3628
{#State 184
3629
DEFAULT => -120
3630
},
3631
{#State 185
3632
DEFAULT => -123
3633
},
3634
{#State 186
3635
ACTIONS => {
3636
'Space' => 185,
3637
'Word' => 187
3638
},
3639
DEFAULT => -32,
3640
GOTOS => {
3641
'word_or_space' => 198
3642
}
3643
},
3644
{#State 187
3645
DEFAULT => -122
3646
},
3647
{#State 188
3648
DEFAULT => -27
3649
},
3650
{#State 189
3651
ACTIONS => {
3652
'Empty_line' => 199
3653
}
3654
},
3655
{#State 190
3656
DEFAULT => -79
3657
},
3658
{#State 191
3659
DEFAULT => -149
3660
},
3661
{#State 192
3662
DEFAULT => -131
3663
},
3664
{#State 193
3665
DEFAULT => -133,
3666
GOTOS => {
3667
'@22-3' => 200
3668
}
3669
},
3670
{#State 194
3671
ACTIONS => {
3672
'Embed' => 30,
3673
'Named_variable' => 21,
3674
'Table_separator' => 32,
3675
'Symbolic_variable' => 33,
3676
'Tag_name' => 34,
3677
'Table' => 37,
3678
'Include' => 36,
3679
'Space' => 23,
3680
'Word' => 27,
3681
'EOL' => 67,
3682
'StreamedPart' => 28
3683
},
3684
GOTOS => {
3685
'basic' => 58,
3686
'embedded' => 31,
3687
'table' => 22,
3688
'literals' => 201,
3689
'element' => 35,
3690
'literal' => 132,
3691
'included' => 24,
3692
'table_separator' => 25,
3693
'tag' => 26
3694
}
3695
},
3696
{#State 195
3697
DEFAULT => -142
3698
},
3699
{#State 196
3700
ACTIONS => {
3701
'Embed' => 30,
3702
'Named_variable' => 21,
3703
'Table_separator' => 32,
3704
'Symbolic_variable' => 33,
3705
'Tag_name' => 34,
3706
'Table' => 37,
3707
'Include' => 36,
3708
'Space' => 23,
3709
'Word' => 27,
3710
'EOL' => 67,
3711
'StreamedPart' => 28
3712
},
3713
GOTOS => {
3714
'basic' => 58,
3715
'embedded' => 31,
3716
'table' => 22,
3717
'element' => 35,
3718
'literal' => 46,
3719
'text' => 202,
3720
'table_separator' => 25,
3721
'included' => 24,
3722
'tag' => 26
3723
}
3724
},
3725
{#State 197
3726
ACTIONS => {
3727
'Empty_line' => 203
3728
}
3729
},
3730
{#State 198
3731
DEFAULT => -121
3732
},
3733
{#State 199
3734
DEFAULT => -84
3735
},
3736
{#State 200
3737
ACTIONS => {
3738
"\"" => 206,
3739
'Word' => 204
3740
},
3741
GOTOS => {
3742
'tagvalue' => 205
3743
}
3744
},
3745
{#State 201
3746
ACTIONS => {
3747
'Embed' => 30,
3748
'Named_variable' => 21,
3749
'Table_separator' => 32,
3750
'Symbolic_variable' => 33,
3751
'Tag_name' => 34,
3752
'Table' => 37,
3753
'Include' => 36,
3754
'Space' => 23,
3755
'Word' => 27,
3756
'EOL' => 67,
3757
'StreamedPart' => 28,
3758
">" => 207
3759
},
3760
GOTOS => {
3761
'basic' => 58,
3762
'embedded' => 31,
3763
'table' => 22,
3764
'element' => 35,
3765
'literal' => 162,
3766
'table_separator' => 25,
3767
'included' => 24,
3768
'tag' => 26
3769
}
3770
},
3771
{#State 202
3772
DEFAULT => -156
3773
},
3774
{#State 203
3775
DEFAULT => -146
3776
},
3777
{#State 204
3778
DEFAULT => -135
3779
},
3780
{#State 205
3781
DEFAULT => -134
3782
},
3783
{#State 206
3784
ACTIONS => {
3785
'Embed' => 30,
3786
'Named_variable' => 21,
3787
'Table_separator' => 32,
3788
'Symbolic_variable' => 33,
3789
'Tag_name' => 34,
3790
'Table' => 37,
3791
'Include' => 36,
3792
'Space' => 23,
3793
'Word' => 27,
3794
'StreamedPart' => 28
3795
},
3796
GOTOS => {
3797
'basic' => 20,
3798
'basics' => 208,
3799
'embedded' => 31,
3800
'table' => 22,
3801
'element' => 35,
3802
'table_separator' => 25,
3803
'included' => 24,
3804
'tag' => 26
3805
}
3806
},
3807
{#State 207
3808
DEFAULT => -139
3809
},
3810
{#State 208
3811
ACTIONS => {
3812
'Embed' => 30,
3813
'Named_variable' => 21,
3814
'Table_separator' => 32,
3815
'Symbolic_variable' => 33,
3816
'Tag_name' => 34,
3817
'Table' => 37,
3818
'Include' => 36,
3819
'Space' => 23,
3820
"\"" => 209,
3821
'Word' => 27,
3822
'StreamedPart' => 28
3823
},
3824
GOTOS => {
3825
'basic' => 83,
3826
'embedded' => 31,
3827
'included' => 24,
3828
'table_separator' => 25,
3829
'table' => 22,
3830
'tag' => 26,
3831
'element' => 35
3832
}
3833
},
3834
{#State 209
3835
DEFAULT => -136
3836
}
3837
],
3838
yyrules =>
3839
[
3840
[#Rule 0
3841
'$start', 2, undef
3842
],
3843
[#Rule 1
3844
'document', 1,
3845
sub
3846
#line 1707 "ppParser.yp"
3847
{
3848
# skip empty "paragraphs"
3849
unless ($_[1][0]=~/^\s*$/ or not @{$_[1][0]})
3850
{
3851
# add data to the output stream
3852
push(@{$resultStreamRef->[STREAM_TOKENS]}, @{$_[1][0]});
3853
3854
# update tag finish memory
3855
_updateTagFinishMem(scalar(@{$resultStreamRef->[STREAM_TOKENS]}));
3856
3857
# update checksums (unless done before for parts)
3858
_updateChecksums($_[1][0], 'Paragraph_cache_hit') unless $_[1][0][0][STREAM_DIR_TYPE]==DIRECTIVE_BLOCK
3859
or $_[1][0][0][STREAM_DIR_TYPE]==DIRECTIVE_DLIST
3860
or $_[1][0][0][STREAM_DIR_TYPE]==DIRECTIVE_OLIST
3861
or $_[1][0][0][STREAM_DIR_TYPE]==DIRECTIVE_ULIST
3862
or $_[1][0][0][STREAM_DIR_TYPE]==DIRECTIVE_HEADLINE;
3863
3864
# update statistics, if necessary
3865
$statistics{$_[1][0][0][STREAM_DIR_TYPE]}++ unless not defined $_[1][0][0][STREAM_DIR_TYPE] or exists $embeddedParagraphs{$_[1][0][0][STREAM_DIR_TYPE]};
3866
3867
# perform special headline operations
3868
if ($_[1][0][0][STREAM_DIR_TYPE]==DIRECTIVE_HEADLINE)
3869
{
3870
# update headline stream by adding the token index of the headline
3871
push(@{$resultStreamRef->[STREAM_HEADLINES]}, @{$resultStreamRef->[STREAM_TOKENS]}-@{$_[1][0]});
3872
3873
# add a copy of the variables valid at the end of the page
3874
$_[1][0][0][STREAM_DIR_HINTS]{vars}=dclone(\%variables);
3875
3876
# let the user know that something is going on
3877
print STDERR "\r", ' ' x length('[Info] '), '... ', $statistics{&DIRECTIVE_HEADLINE}, " chapters read."
3878
if $flags{vis}
3879
and not $statistics{&DIRECTIVE_HEADLINE} % $flags{vis};
3880
}
3881
elsif ($_[1][0][0][STREAM_DIR_TYPE]!=DIRECTIVE_COMMENT)
3882
{
3883
# the document starts with streamed content before the first headline,
3884
# this is considered an error except when this happens due to an import
3885
_semerr($_[0], "$sourceFile, line $_[1][1]: the first chapter needs a headline, please add one.") unless exists $flags{complainedAbout1stHeadline};
3886
3887
# update complaint flag
3888
if (exists $flags{complainedAbout1stHeadline} and $flags{complainedAbout1stHeadline} eq 'IMPORT')
3889
{delete $flags{complainedAbout1stHeadline};}
3890
else
3891
{$flags{complainedAbout1stHeadline}=1;}
3892
}
3893
3894
# this is for the parser to flag success
3895
1;
3896
}
3897
}
3898
],
3899
[#Rule 2
3900
'document', 2,
3901
sub
3902
#line 1759 "ppParser.yp"
3903
{
3904
# skip empty "paragraphs"
3905
unless ($_[2][0]=~/^\s*$/ or not @{$_[2][0]})
3906
{
3907
# add data to the output stream, if necessary
3908
push(@{$resultStreamRef->[STREAM_TOKENS]}, @{$_[2][0]});
3909
3910
# update tag finish memory
3911
_updateTagFinishMem(scalar(@{$resultStreamRef->[STREAM_TOKENS]}));
3912
3913
# update checksums, if necessary
3914
_updateChecksums($_[2][0], 'Paragraph_cache_hit') unless $_[2][0][0][STREAM_DIR_TYPE]==DIRECTIVE_BLOCK
3915
or $_[2][0][0][STREAM_DIR_TYPE]==DIRECTIVE_DLIST
3916
or $_[2][0][0][STREAM_DIR_TYPE]==DIRECTIVE_OLIST
3917
or $_[2][0][0][STREAM_DIR_TYPE]==DIRECTIVE_ULIST
3918
or $_[2][0][0][STREAM_DIR_TYPE]==DIRECTIVE_HEADLINE;
3919
3920
# update ordered list flag as necessary
3921
$flags{olist}=0 unless $_[2][0][0][STREAM_DIR_TYPE]==DIRECTIVE_OLIST;
3922
3923
# update statistics, if necessary
3924
$statistics{$_[2][0][0][STREAM_DIR_TYPE]}++ unless exists $embeddedParagraphs{$_[2][0][0][STREAM_DIR_TYPE]};
3925
3926
# perform special headline operations
3927
if ($_[2][0][0][STREAM_DIR_TYPE]==DIRECTIVE_HEADLINE)
3928
{
3929
# update headline stream by adding the token index of the headline
3930
push(@{$resultStreamRef->[STREAM_HEADLINES]}, @{$resultStreamRef->[STREAM_TOKENS]}-@{$_[2][0]});
3931
3932
# add a copy of the variables valid at the end of the page
3933
$_[2][0][0][STREAM_DIR_HINTS]{vars}=dclone(\%variables);
3934
3935
# let the user know that something is going on, if necessary
3936
print STDERR "\r", ' ' x length('[Info] '), '... ', $statistics{&DIRECTIVE_HEADLINE}, " chapters read."
3937
if $flags{vis}
3938
and not $statistics{&DIRECTIVE_HEADLINE} % $flags{vis};
3939
}
3940
elsif (
3941
$_[2][0][0][STREAM_DIR_TYPE]!=DIRECTIVE_COMMENT
3942
and not @{$resultStreamRef->[STREAM_HEADLINES]}
3943
and (
3944
not exists $flags{complainedAbout1stHeadline}
3945
or $flags{complainedAbout1stHeadline} eq 'IMPORT'
3946
)
3947
)
3948
{
3949
# the document starts with streamed content before the first headline,
3950
# this is considered an error except when this happens due to an import
3951
_semerr($_[0], "$sourceFile, line $_[2][1]: the first chapter needs a headline, please add one.") unless exists $flags{complainedAbout1stHeadline};
3952
3953
# update complaint flag
3954
if (exists $flags{complainedAbout1stHeadline} and $flags{complainedAbout1stHeadline} eq 'IMPORT')
3955
{delete $flags{complainedAbout1stHeadline};}
3956
else
3957
{$flags{complainedAbout1stHeadline}=1;}
3958
}
3959
3960
# this is for the parser to flag success
3961
1;
3962
}
3963
}
3964
],
3965
[#Rule 3
3966
'optional_paragraph_filter', 0, undef
3967
],
3968
[#Rule 4
3969
'@1-1', 0,
3970
sub
3971
#line 1826 "ppParser.yp"
3972
{
3973
# switch to pfiltered mode
3974
_stateManager(STATE_PFILTER);
3975
}
3976
],
3977
[#Rule 5
3978
'optional_paragraph_filter', 4,
3979
sub
3980
#line 1831 "ppParser.yp"
3981
{
3982
# back to default mode
3983
_stateManager(STATE_PFILTERED);
3984
3985
# supply filter list
3986
$_[3];
3987
}
3988
],
3989
[#Rule 6
3990
'paragraph_filters', 1,
3991
sub
3992
#line 1843 "ppParser.yp"
3993
{
3994
# start a new filter list
3995
[[$_[1][0]], $_[1][1]];
3996
}
3997
],
3998
[#Rule 7
3999
'paragraph_filters', 3,
4000
sub
4001
#line 1848 "ppParser.yp"
4002
{
4003
# append to filter list and reply updated list
4004
push(@{$_[1][0]}, $_[3][0]);
4005
[$_[1][0], $_[3][1]];
4006
}
4007
],
4008
[#Rule 8
4009
'paragraph', 1, undef
4010
],
4011
[#Rule 9
4012
'paragraph', 1, undef
4013
],
4014
[#Rule 10
4015
'@2-1', 0,
4016
sub
4017
#line 1865 "ppParser.yp"
4018
{
4019
# filter set?
4020
if ($_[1])
4021
{
4022
# prepare an extra "token" to start the next paragraph
4023
$flags{virtualParagraphStart}=1;
4024
4025
# Disable storage of a checksum. (A filter can make the paragraph depending
4026
# on something outside the paragraph - the paragraph becomes dynamic.)
4027
$flags{checksummed}=0;
4028
}
4029
}
4030
],
4031
[#Rule 11
4032
'built_paragraph', 3,
4033
sub
4034
#line 1878 "ppParser.yp"
4035
{
4036
# reset the "extra token" flag (it already worked when the parser
4037
# reaches this point)
4038
$flags{virtualParagraphStart}=0;
4039
4040
# filters installed and active?
4041
if ($_[1])
4042
{
4043
# Does the caller want to evaluate code?
4044
if ($safeObject)
4045
{
4046
# update active contents base data, if necessary
4047
if ($flags{activeBaseData})
4048
{
4049
no strict 'refs';
4050
${join('::', ref($safeObject) ? $safeObject->root : 'main', 'PerlPoint')}=dclone($flags{activeBaseData});
4051
}
4052
4053
# peform filter call(s)
4054
my $result=_pfilterCall($_[0], $_[1][0], $_[3][0], $_[3][1]);
4055
4056
# reply unmodified paragraph in case of an error
4057
return $_[3] unless defined $result;
4058
4059
# make the result part of the input stream, if any
4060
_stackInput($_[0], @$result) if $result;
4061
4062
# reset the "end of input reached" flag if necessary
4063
$readCompletely=0 if $readCompletely;
4064
4065
# supply nothing here, the result must be reparsed first
4066
['', $_[3][2]];
4067
}
4068
else
4069
{
4070
# filters cannot be run, inform user
4071
warn "[Warn] $sourceFile, line $_[1][1]: Active Content is disabled, paragraph cannot be filtered.\n" unless $flags{display} & DISPLAY_NOWARN;
4072
4073
# supply the unmodified paragraph
4074
$_[3];
4075
}
4076
}
4077
else
4078
{
4079
# no filter: provide paragraph data
4080
$_[3];
4081
}
4082
}
4083
],
4084
[#Rule 12
4085
'built_paragraph', 1, undef
4086
],
4087
[#Rule 13
4088
'original_paragraph', 1, undef
4089
],
4090
[#Rule 14
4091
'original_paragraph', 1,
4092
sub
4093
#line 1932 "ppParser.yp"
4094
{
4095
# remove leading dummy tokens which might have been produced by "standalone macros"
4096
splice(@{$_[1][0]}, 1, 1) while @{$_[1][0]}>1 and !ref($_[1][0][1]) and $_[1][0][1] eq DUMMY_TOKEN;
4097
4098
# check if this paragraph consists of exactly one table only
4099
# or exactly one tag which is allowed to exists standalone,
4100
# or exactly one embedded region
4101
if (
4102
(
4103
# starting with a table tag or standalone tag?
4104
@{$_[1][0]}>1
4105
and ref($_[1][0][1]) eq 'ARRAY'
4106
and $_[1][0][1][STREAM_DIR_TYPE]==DIRECTIVE_TAG
4107
and (
4108
$_[1][0][1][STREAM_DIR_DATA]=~/^(TABLE)$/
4109
or (
4110
$_[1][0][1][STREAM_DIR_DATA]=~/^(\w+)$/
4111
and (
4112
(
4113
exists $tagsRef->{$1}
4114
and exists $tagsRef->{$1}{standalone}
4115
and $tagsRef->{$1}{standalone}
4116
)
4117
or $1 eq 'EMBED'
4118
)
4119
)
4120
)
4121
4122
# ending with the same tag?
4123
and ref($_[1][0][-2]) eq 'ARRAY'
4124
and $_[1][0][-2][STREAM_DIR_TYPE]==DIRECTIVE_TAG
4125
and $_[1][0][-2][STREAM_DIR_DATA] eq $1
4126
4127
# both building the same tag?
4128
and $_[1][0][-2][STREAM_DIR_DATA+1] eq $_[1][0][1][STREAM_DIR_DATA+1]
4129
)
4130
)
4131
{
4132
# remove the enclosing paragraph stuff - just return the contents (table / tag)
4133
shift(@{$_[1][0]}); # text paragraph opener
4134
pop(@{$_[1][0]}); # text paragraph trailer
4135
}
4136
4137
# pass (original or modified) data
4138
$_[1];
4139
}
4140
],
4141
[#Rule 15
4142
'original_paragraph', 1, undef
4143
],
4144
[#Rule 16
4145
'original_paragraph', 1, undef
4146
],
4147
[#Rule 17
4148
'original_paragraph', 1, undef
4149
],
4150
[#Rule 18
4151
'original_paragraph', 1, undef
4152
],
4153
[#Rule 19
4154
'original_paragraph', 1, undef
4155
],
4156
[#Rule 20
4157
'original_paragraph', 1, undef
4158
],
4159
[#Rule 21
4160
'original_paragraph', 1, undef
4161
],
4162
[#Rule 22
4163
'non_filterable_paragraph', 1, undef
4164
],
4165
[#Rule 23
4166
'non_filterable_paragraph', 1, undef
4167
],
4168
[#Rule 24
4169
'non_filterable_paragraph', 1, undef
4170
],
4171
[#Rule 25
4172
'restored_paragraph', 1, undef
4173
],
4174
[#Rule 26
4175
'@3-1', 0,
4176
sub
4177
#line 2003 "ppParser.yp"
4178
{
4179
# switch to headline mode
4180
_stateManager(STATE_HEADLINE);
4181
4182
# update headline level hints
4183
$flags{headlineLevel}=$_[1][0];
4184
4185
# trace, if necessary
4186
warn "[Trace] $sourceFile, line $_[1][1]: Headline (of level $_[1][0]) starts.\n" if $flags{trace} & TRACE_PARAGRAPHS;
4187
}
4188
],
4189
[#Rule 27
4190
'headline', 5,
4191
sub
4192
#line 2014 "ppParser.yp"
4193
{
4194
# back to default mode
4195
_stateManager(STATE_DEFAULT);
4196
4197
# trace, if necessary
4198
warn "[Trace] $sourceFile, line $_[5][1]: Headline completed.\n" if $flags{trace} & TRACE_PARAGRAPHS;
4199
4200
# remove trailing whitespaces (the final one represents the final newline)
4201
pop(@{$_[3][0]}) while @{$_[3][0]} and $_[3][0][-1]=~/^\s*$/;
4202
4203
# abbreviation declared?
4204
if ($_[4][0])
4205
{
4206
# remove trailing whitespaces which separated a shortcut directive from
4207
# the long headline title version, if a shortcut was specified
4208
$_[3][0][-1]=~s/\s+$//;
4209
# remove leading and trailing whitespaces from the shortcut
4210
$_[4][0]=~s/^\s+//;
4211
$_[4][0]=~s/\s+$//;
4212
}
4213
4214
# update related data
4215
@olistLevels=();
4216
4217
# update directive counter and the level hierarchy memory
4218
$#headlineIds=$flags{headlineLevel}-1;
4219
$headlineIds[$flags{headlineLevel}-1]=++$flags{headlinenr};
4220
4221
# prepare result (data part and shortcut string)
4222
my %hints=(
4223
nr => ++$directiveCounter,
4224
shortcut => $_[4][0],
4225
docstreams => {},
4226
);
4227
my $data=[
4228
# opener directive (including headline level)
4229
[\%hints, DIRECTIVE_HEADLINE, DIRECTIVE_START, $_[1][0]],
4230
# the list of enclosed literals
4231
@{$_[3][0]},
4232
# final directive (including headline level again)
4233
[\%hints, DIRECTIVE_HEADLINE, DIRECTIVE_COMPLETE, $_[1][0]]
4234
];
4235
4236
# update checksums (done here because hits need special handling)
4237
_updateChecksums($data, 'Headline_cache_hit');
4238
4239
# update pointer to the current docstream hash
4240
$flags{chapterDocstreams}=$hints{docstreams};
4241
4242
# reply data
4243
[$data, $_[5][1]];
4244
}
4245
],
4246
[#Rule 28
4247
'headline', 1,
4248
sub
4249
#line 2067 "ppParser.yp"
4250
{
4251
# update headline level hint
4252
$flags{headlineLevel}=$_[1][0][0][STREAM_DIR_DATA];
4253
4254
# reset chapter docstream hash and update the appropriate pointer
4255
$flags{chapterDocstreams}=$_[1][0][0][STREAM_DIR_HINTS]{docstreams}={};
4256
4257
# supply what you got unchanged
4258
$_[1];
4259
}
4260
],
4261
[#Rule 29
4262
'headline_level', 1,
4263
sub
4264
#line 2081 "ppParser.yp"
4265
{
4266
# switch to headline intro mode
4267
_stateManager(STATE_HEADLINE_LEVEL);
4268
4269
# start new counter and reply it
4270
[$flags{headlineLevelOffset}+1, $_[1][1]];
4271
}
4272
],
4273
[#Rule 30
4274
'headline_level', 2,
4275
sub
4276
#line 2089 "ppParser.yp"
4277
{
4278
# update counter and reply it
4279
[$_[1][0]+1, $_[1][1]];
4280
}
4281
],
4282
[#Rule 31
4283
'optional_headline_shortcut', 0,
4284
sub
4285
#line 2097 "ppParser.yp"
4286
{
4287
# nothing declared: supply an empty shortcut string
4288
['', $lineNrs{$inHandle}];
4289
}
4290
],
4291
[#Rule 32
4292
'optional_headline_shortcut', 2,
4293
sub
4294
#line 2102 "ppParser.yp"
4295
{
4296
# reply the shortcut string
4297
[join('', @{$_[2][0]}), $lineNrs{$inHandle}];
4298
}
4299
],
4300
[#Rule 33
4301
'@4-1', 0,
4302
sub
4303
#line 2110 "ppParser.yp"
4304
{
4305
# switch to condition mode
4306
_stateManager(STATE_CONDITION);
4307
4308
# trace, if necessary
4309
warn "[Trace] $sourceFile, line $_[1][1]: Condition paragraph starts.\n" if $flags{trace} & TRACE_PARAGRAPHS;
4310
}
4311
],
4312
[#Rule 34
4313
'condition', 4,
4314
sub
4315
#line 2118 "ppParser.yp"
4316
{
4317
# back to default mode
4318
_stateManager(STATE_DEFAULT);
4319
4320
# trace, if necessary
4321
warn "[Trace] $sourceFile, line $_[4][1]: condition completed.\n" if $flags{trace} & TRACE_PARAGRAPHS;
4322
4323
# The condition is written in Perl, anything passed really?
4324
# And does the caller want to evaluate the code?
4325
if (@{$_[3][0]} and $safeObject)
4326
{
4327
# trace, if necessary
4328
warn "[Trace] Evaluating condition ...\n" if $flags{trace} & TRACE_SEMANTIC;
4329
4330
# update active contents base data, if necessary
4331
if ($flags{activeBaseData})
4332
{
4333
no strict 'refs';
4334
${join('::', ref($safeObject) ? $safeObject->root : 'main', 'PerlPoint')}=dclone($flags{activeBaseData});
4335
}
4336
4337
# make the Perl code a string and evaluate it
4338
my $perl=join('', @{$_[3][0]});
4339
$^W=0;
4340
warn "[Trace] $sourceFile, line $_[3][1]: Evaluating condition code:\n\n$perl\n\n\n" if $flags{trace} & TRACE_ACTIVE;
4341
my $result=ref($safeObject) ? $safeObject->reval($perl) : eval(join(' ', '{package main; no strict;', $perl, '}'));
4342
$^W=1;
4343
4344
# check result
4345
if ($@)
4346
{_semerr($_[0], "$sourceFile, line $_[3][1]: condition code could not be evaluated: $@.");}
4347
else
4348
{
4349
# trace, if necessary
4350
warn "[Trace] Condition is ", (defined $result and $result) ? 'true, parsing continues' : 'false, parsing is temporarily suspended', ".\n" if $flags{trace} & TRACE_ACTIVE or $flags{trace} & TRACE_SEMANTIC;
4351
4352
# success - configure parser behaviour according to result
4353
$flags{skipInput}=1 unless (defined $result and $result);
4354
}
4355
}
4356
else
4357
{
4358
# trace, if necessary
4359
warn "[Trace] Condition is not evaluated because of disabled active contents.\n" if $flags{trace} & TRACE_SEMANTIC;
4360
}
4361
4362
# we have to supply something, but it should be nothing (note that this is a *paragraph*, so reply a *string*)
4363
['', $_[4][1]];
4364
}
4365
],
4366
[#Rule 35
4367
'list', 1, undef
4368
],
4369
[#Rule 36
4370
'list', 2,
4371
sub
4372
#line 2172 "ppParser.yp"
4373
{
4374
# update token list and reply it
4375
push(@{$_[1][0]}, @{$_[2][0]});
4376
[$_[1][0], $_[2][1]];
4377
}
4378
],
4379
[#Rule 37
4380
'list', 3,
4381
sub
4382
#line 2178 "ppParser.yp"
4383
{
4384
# update statistics, if necessary (shifters are not passed as standalone paragraphs, so ...)
4385
$statistics{$_[2][0][0][1]}++;
4386
4387
# add shift informations to related list parts: the predecessor
4388
# gets informations about a following shift, the successor about
4389
# a predecessing shift
4390
@{$_[1][0][-1]}[STREAM_DIR_DATA+3, STREAM_DIR_DATA+4]
4391
=@{$_[3][0][ 0]}[STREAM_DIR_DATA+1, STREAM_DIR_DATA+2]
4392
=@{$_[2][0][ 0]}[STREAM_DIR_TYPE, STREAM_DIR_DATA];
4393
4394
# update token list and reply it
4395
push(@{$_[1][0]}, @{$_[2][0]}, @{$_[3][0]});
4396
[$_[1][0], $_[3][1]];
4397
}
4398
],
4399
[#Rule 38
4400
'list_part', 1,
4401
sub
4402
#line 2197 "ppParser.yp"
4403
{
4404
# the first point may start by a certain number, check this
4405
my $start=(defined $_[1][0][0][STREAM_DIR_DATA] and $_[1][0][0][STREAM_DIR_DATA]>1) ? $_[1][0][0][STREAM_DIR_DATA] : 1;
4406
4407
# embed the points into list directives
4408
my %hints=(nr=>++$directiveCounter);
4409
[
4410
[
4411
# opener directive
4412
[\%hints, DIRECTIVE_OLIST, DIRECTIVE_START, $start, (0) x 4],
4413
# the list of enclosed literals
4414
@{$_[1][0]},
4415
# final directive
4416
[\%hints, DIRECTIVE_OLIST, DIRECTIVE_COMPLETE, $start, (0) x 4]
4417
],
4418
$_[1][1]
4419
];
4420
}
4421
],
4422
[#Rule 39
4423
'list_part', 1,
4424
sub
4425
#line 2216 "ppParser.yp"
4426
{
4427
# reset ordered list flag
4428
$flags{olist}=0;
4429
4430
# embed the points into list directives
4431
my %hints=(nr=>++$directiveCounter);
4432
[
4433
[
4434
# opener directive
4435
[\%hints, DIRECTIVE_ULIST, DIRECTIVE_START, 0, (0) x 4],
4436
# the list of enclosed literals
4437
@{$_[1][0]},
4438
# final directive
4439
[\%hints, DIRECTIVE_ULIST, DIRECTIVE_COMPLETE, 0, (0) x 4]
4440
],
4441
$_[1][1]
4442
];
4443
}
4444
],
4445
[#Rule 40
4446
'list_part', 1,
4447
sub
4448
#line 2235 "ppParser.yp"
4449
{
4450
# reset ordered list flag
4451
$flags{olist}=0;
4452
4453
# embed the points into list directives
4454
my %hints=(nr=>++$directiveCounter);
4455
[
4456
[
4457
# opener directive
4458
[\%hints, DIRECTIVE_DLIST, DIRECTIVE_START, 0, (0) x 4],
4459
# the list of enclosed literals
4460
@{$_[1][0]},
4461
# final directive
4462
[\%hints, DIRECTIVE_DLIST, DIRECTIVE_COMPLETE, 0, (0) x 4]
4463
],
4464
$_[1][1]
4465
];
4466
}
4467
],
4468
[#Rule 41
4469
'olist', 1, undef
4470
],
4471
[#Rule 42
4472
'olist', 2,
4473
sub
4474
#line 2258 "ppParser.yp"
4475
{
4476
# update token list and reply it
4477
push(@{$_[1][0]}, @{$_[2][0]});
4478
[$_[1][0], $_[2][1]];
4479
}
4480
],
4481
[#Rule 43
4482
'ulist', 1, undef
4483
],
4484
[#Rule 44
4485
'ulist', 2,
4486
sub
4487
#line 2268 "ppParser.yp"
4488
{
4489
# update token list and reply it
4490
push(@{$_[1][0]}, @{$_[2][0]});
4491
[$_[1][0], $_[2][1]];
4492
}
4493
],
4494
[#Rule 45
4495
'dlist', 1, undef
4496
],
4497
[#Rule 46
4498
'dlist', 2,
4499
sub
4500
#line 2278 "ppParser.yp"
4501
{
4502
# update token list and reply it
4503
push(@{$_[1][0]}, @{$_[2][0]});
4504
[$_[1][0], $_[2][1]];
4505
}
4506
],
4507
[#Rule 47
4508
'@5-1', 0,
4509
sub
4510
#line 2287 "ppParser.yp"
4511
{
4512
# switch to opoint mode
4513
_stateManager(STATE_OPOINT);
4514
4515
# trace, if necessary
4516
warn "[Trace] $sourceFile, line $_[1][1]: Ordered list point starts.\n" if $flags{trace} & TRACE_PARAGRAPHS;
4517
}
4518
],
4519
[#Rule 48
4520
'opoint', 3,
4521
sub
4522
#line 2295 "ppParser.yp"
4523
{
4524
# update statistics (list points are not passed as standalone paragraphs, so ...)
4525
$statistics{&DIRECTIVE_OPOINT}++;
4526
4527
# trace, if necessary
4528
warn "[Trace] $sourceFile, line $_[3][1]: Ordered list point completed.\n" if $flags{trace} & TRACE_PARAGRAPHS;
4529
4530
# remove leading whitespaces from point text (it separated number wildcard and literal text part)
4531
splice(@{$_[3][0]}, 1, 1) while not ref($_[3][0][1]) and $_[3][0][1]=~/^\s*$/;
4532
4533
# reply data (they are already well prepared except that they are marked as text)
4534
$_[3][0][0][STREAM_DIR_TYPE]=$_[3][0][-1][STREAM_DIR_TYPE]=&DIRECTIVE_OPOINT;
4535
4536
# update list level hints as necessary
4537
$olistLevels[0]=(($flags{olist} or $_[1][0]) and @olistLevels) ? $olistLevels[0]+1 : 1;
4538
4539
# add a level hint, if necessary
4540
if ($_[1][0] and not $flags{olist} and $olistLevels[0]>1)
4541
{
4542
push(@{$_[3][0][0]}, $olistLevels[0]);
4543
push(@{$_[3][0][-1]}, $olistLevels[0]);
4544
}
4545
4546
# update ordered list flag
4547
$flags{olist}=1;
4548
4549
# update checksums, if possible
4550
$flags{checksummed}=0 unless $flags{virtualParagraphStart};
4551
_updateChecksums($_[3][0], 'Opoint_cache_hit');
4552
4553
# supply result
4554
$_[3];
4555
}
4556
],
4557
[#Rule 49
4558
'opoint', 1,
4559
sub
4560
#line 2329 "ppParser.yp"
4561
{
4562
# update list level hints as necessary
4563
$olistLevels[0]=($flags{olist} and @olistLevels) ? $olistLevels[0]+1 : 1;
4564
4565
# update continued list points
4566
$_[1][0][0][STREAM_DIR_DATA]=$olistLevels[0] if @{$_[1][0][0]}>3;
4567
4568
# update ordered list flag
4569
$flags{olist}=1;
4570
4571
# supply updated stream snippet
4572
$_[1];
4573
}
4574
],
4575
[#Rule 50
4576
'opoint_opener', 1,
4577
sub
4578
#line 2347 "ppParser.yp"
4579
{[0, $_[1][1]];}
4580
],
4581
[#Rule 51
4582
'opoint_opener', 2,
4583
sub
4584
#line 2349 "ppParser.yp"
4585
{[1, $_[1][1]];}
4586
],
4587
[#Rule 52
4588
'@6-1', 0,
4589
sub
4590
#line 2354 "ppParser.yp"
4591
{
4592
# switch to upoint mode
4593
_stateManager(STATE_UPOINT);
4594
4595
# trace, if necessary
4596
warn "[Trace] $sourceFile, line $_[1][1]: Unordered list point starts.\n" if $flags{trace} & TRACE_PARAGRAPHS;
4597
}
4598
],
4599
[#Rule 53
4600
'upoint', 3,
4601
sub
4602
#line 2362 "ppParser.yp"
4603
{
4604
# update statistics (list points are not passed as standalone paragraphs, so ...)
4605
$statistics{&DIRECTIVE_UPOINT}++;
4606
4607
# trace, if necessary
4608
warn "[Trace] $sourceFile, line $_[3][1]: Unordered list point completed.\n" if $flags{trace} & TRACE_PARAGRAPHS;
4609
4610
# remove leading whitespaces from point text (it separated bullet and literal text part)
4611
splice(@{$_[3][0]}, 1, 1) while not ref($_[3][0][1]) and $_[3][0][1]=~/^\s*$/;
4612
4613
# remove trailing whitespaces from point text (it represents the final newline character)
4614
splice(@{$_[3][0]}, -2, 1) while not ref($_[3][0][-2]) and $_[3][0][-2]=~/^\s*$/;
4615
4616
# reply data (they are already well prepared except that they are marked as text)
4617
$_[3][0][0][STREAM_DIR_TYPE]=$_[3][0][-1][STREAM_DIR_TYPE]=&DIRECTIVE_UPOINT;
4618
4619
# update checksums, if possible
4620
$flags{checksummed}=0 unless $flags{virtualParagraphStart};
4621
_updateChecksums($_[3][0], 'Upoint_cache_hit');
4622
4623
# supply result
4624
$_[3];
4625
}
4626
],
4627
[#Rule 54
4628
'upoint', 1, undef
4629
],
4630
[#Rule 55
4631
'@7-1', 0,
4632
sub
4633
#line 2391 "ppParser.yp"
4634
{
4635
}
4636
],
4637
[#Rule 56
4638
'dpoint', 3,
4639
sub
4640
#line 2394 "ppParser.yp"
4641
{
4642
# update statistics (list points are not passed as standalone paragraphs, so ...)
4643
$statistics{&DIRECTIVE_DPOINT}++;
4644
4645
# trace, if necessary
4646
warn "[Trace] $sourceFile, line $_[3][1]: Definition list point completed.\n" if $flags{trace} & TRACE_PARAGRAPHS;
4647
4648
# remove leading whitespaces from point text (it separated point introduction and literal text part)
4649
splice(@{$_[3][0]}, 1, 1) while not ref($_[3][0][1]) and $_[3][0][1]=~/^\s*$/;
4650
4651
# reply data (they are already well prepared except that they are marked as text, and that the definition item stream needs to be added)
4652
my ($hints1, $hints2, $hints3)=({nr=>++$directiveCounter}, {nr=>++$directiveCounter}, {nr=>++$directiveCounter});
4653
$_[3][0][0]=[$hints1, DIRECTIVE_DPOINT, DIRECTIVE_START];
4654
$_[3][0][-1]=[$hints1, DIRECTIVE_DPOINT, DIRECTIVE_COMPLETE];
4655
4656
# insert the definition item stream and an envelope for the explanation part
4657
splice(@{$_[3][0]}, 1, 0,
4658
[$hints2, DIRECTIVE_DPOINT_ITEM, DIRECTIVE_START],
4659
@{$_[1][0]},
4660
[$hints2, DIRECTIVE_DPOINT_ITEM, DIRECTIVE_COMPLETE],
4661
[$hints3, DIRECTIVE_DPOINT_TEXT, DIRECTIVE_START],
4662
);
4663
splice(@{$_[3][0]}, -1, 0, [$hints3, DIRECTIVE_DPOINT_TEXT, DIRECTIVE_COMPLETE]);
4664
4665
# update checksums, if possible
4666
$flags{checksummed}=0 unless $flags{virtualParagraphStart};
4667
_updateChecksums($_[3][0], 'Dpoint_cache_hit');
4668
4669
# supply the result
4670
$_[3];
4671
}
4672
],
4673
[#Rule 57
4674
'dpoint', 1, undef
4675
],
4676
[#Rule 58
4677
'@8-1', 0,
4678
sub
4679
#line 2431 "ppParser.yp"
4680
{
4681
# switch to dlist item mode
4682
_stateManager(STATE_DPOINT_ITEM);
4683
4684
# trace, if necessary
4685
warn "[Trace] $sourceFile, line $_[1][1]: Definition list point starts.\n" if $flags{trace} & TRACE_PARAGRAPHS;
4686
}
4687
],
4688
[#Rule 59
4689
'dlist_opener', 4,
4690
sub
4691
#line 2439 "ppParser.yp"
4692
{
4693
# switch to dlist body mode
4694
_stateManager(STATE_DPOINT);
4695
4696
# simply pass the elements
4697
[$_[3][0], $_[4][1]];
4698
}
4699
],
4700
[#Rule 60
4701
'compound_block', 1, undef
4702
],
4703
[#Rule 61
4704
'compound_block', 2,
4705
sub
4706
#line 2452 "ppParser.yp"
4707
{
4708
# this is tricky - to combine both blocks, we have to remove the already
4709
# embedded stop/start directives and to supply the ...
4710
[
4711
[
4712
# ... original collection WITHOUT the final directive ...
4713
@{$_[1][0]}[0..$#{$_[1][0]}-1],
4714
# insert two additional newline characters (restoring the original empty line)
4715
"\n\n",
4716
# ... combined with the new block, except of its INTRO directive
4717
@{$_[2][0]}[1..$#{$_[2][0]}],
4718
],
4719
$_[2][1]
4720
];
4721
}
4722
],
4723
[#Rule 62
4724
'compound_block', 3,
4725
sub
4726
#line 2468 "ppParser.yp"
4727
{
4728
# update statistics (for the first part which is completed by the intermediate flag paragraph)
4729
$statistics{&DIRECTIVE_BLOCK}++;
4730
4731
# this is simply a list of both blocks
4732
[
4733
[
4734
# original collection
4735
@{$_[1][0]},
4736
# ... followed by the new block
4737
@{$_[3][0]},
4738
],
4739
$_[3][1]
4740
];
4741
}
4742
],
4743
[#Rule 63
4744
'@9-1', 0,
4745
sub
4746
#line 2487 "ppParser.yp"
4747
{
4748
# switch to control mode
4749
_stateManager(STATE_CONTROL);
4750
4751
# trace, if necessary
4752
warn "[Trace] $sourceFile, line $_[1][1]: New block flag starts.\n" if $flags{trace} & TRACE_PARAGRAPHS;
4753
}
4754
],
4755
[#Rule 64
4756
'block_flagnew', 3,
4757
sub
4758
#line 2495 "ppParser.yp"
4759
{
4760
# back to default mode
4761
_stateManager(STATE_DEFAULT);
4762
4763
# trace, if necessary
4764
warn "[Trace] $sourceFile, line $_[1][1]: New block flag completed.\n" if $flags{trace} & TRACE_PARAGRAPHS;
4765
4766
# reply data (these are dummies because block connectors are not made part of the output stream)
4767
$_[3];
4768
}
4769
],
4770
[#Rule 65
4771
'@10-1', 0,
4772
sub
4773
#line 2509 "ppParser.yp"
4774
{
4775
# switch to block mode
4776
_stateManager(STATE_BLOCK);
4777
4778
# trace, if necessary
4779
warn "[Trace] $sourceFile, line $_[1][1]: Block starts.\n" if $flags{trace} & TRACE_PARAGRAPHS;
4780
}
4781
],
4782
[#Rule 66
4783
'block', 3,
4784
sub
4785
#line 2517 "ppParser.yp"
4786
{
4787
# trace, if necessary
4788
warn "[Trace] $sourceFile, line $_[3][1]: Block completed.\n" if $flags{trace} & TRACE_PARAGRAPHS;
4789
4790
# reply data (they are almost perfect except that they are marked as text,
4791
# and that the initial spaces have to be inserted, and that a trailing newline
4792
# has to be removed)
4793
$_[3][0][0][STREAM_DIR_TYPE]=$_[3][0][-1][STREAM_DIR_TYPE]=DIRECTIVE_BLOCK;
4794
splice(@{$_[3][0]}, 1, 0, $_[1][0]);
4795
# remove the final newline made from the last carriage return, if any
4796
splice(@{$_[3][0]}, -2, 1) if @{$_[3][0]}>2 and defined $_[3][0][-2] and $_[3][0][-2] eq "\n";
4797
4798
# update checksums, if possible
4799
$flags{checksummed}=0 unless $flags{virtualParagraphStart};
4800
_updateChecksums($_[3][0], 'Block_cache_hit');
4801
4802
# supply result
4803
$_[3];
4804
}
4805
],
4806
[#Rule 67
4807
'block', 1, undef
4808
],
4809
[#Rule 68
4810
'optionally_dotted_text', 1, undef
4811
],
4812
[#Rule 69
4813
'optionally_dotted_text', 1, undef
4814
],
4815
[#Rule 70
4816
'@11-1', 0,
4817
sub
4818
#line 2546 "ppParser.yp"
4819
{
4820
# enter text mode - unless we are in a block (or point (which already set this mode itself))
4821
unless ( $parserState==STATE_BLOCK
4822
or $parserState==STATE_UPOINT
4823
or $parserState==STATE_OPOINT
4824
or $parserState==STATE_DPOINT
4825
or $parserState==STATE_DPOINT_ITEM
4826
or $parserState==STATE_DEFINITION
4827
or $parserState==STATE_TEXT
4828
)
4829
{
4830
# switch to new mode
4831
_stateManager(STATE_TEXT);
4832
4833
# trace, if necessary
4834
warn "[Trace] $sourceFile, line $_[1][1]: Text starts.\n" if $flags{trace} & TRACE_PARAGRAPHS;
4835
}
4836
}
4837
],
4838
[#Rule 71
4839
'text', 4,
4840
sub
4841
#line 2566 "ppParser.yp"
4842
{
4843
# trace, if necessary
4844
warn "[Trace] $sourceFile, line $_[4][1]: Text completed.\n" unless not $flags{trace} & TRACE_PARAGRAPHS
4845
or $parserState==STATE_BLOCK
4846
or $parserState==STATE_UPOINT
4847
or $parserState==STATE_OPOINT
4848
or $parserState==STATE_DPOINT
4849
or $parserState==STATE_DPOINT_ITEM;
4850
4851
# back to default mode
4852
_stateManager(STATE_DEFAULT);
4853
4854
# remove the final EOL literal, if any
4855
pop(@{$_[3][0]}) if defined $_[3][0][-1] and $_[3][0][-1] eq 'EOL';
4856
4857
# remove the final whitespace string made from the last carriage return, if any
4858
pop(@{$_[3][0]}) if defined $_[3][0][-1] and $_[3][0][-1] eq ' ';
4859
4860
# reply data, if any
4861
if ((@{$_[1][0]} and $_[1][0][0]) or @{$_[3][0]})
4862
{
4863
my %hints=(nr=>++$directiveCounter);
4864
[
4865
[
4866
# opener directive
4867
[\%hints, DIRECTIVE_TEXT, DIRECTIVE_START],
4868
# the list of enclosed literals
4869
@{$_[1][0]}, @{$_[3][0]},
4870
# final directive
4871
[\%hints, DIRECTIVE_TEXT, DIRECTIVE_COMPLETE],
4872
],
4873
$_[4][1],
4874
];
4875
}
4876
else
4877
{
4878
# reply nothing real
4879
[[()], $_[4][1]];
4880
}
4881
}
4882
],
4883
[#Rule 72
4884
'@12-1', 0,
4885
sub
4886
#line 2610 "ppParser.yp"
4887
{
4888
# switch to new mode (to stop special handling of dots)
4889
_stateManager(STATE_TEXT);
4890
}
4891
],
4892
[#Rule 73
4893
'dotted_text', 3,
4894
sub
4895
#line 2615 "ppParser.yp"
4896
{
4897
# supply the text
4898
$_[3];
4899
}
4900
],
4901
[#Rule 74
4902
'@13-1', 0,
4903
sub
4904
#line 2623 "ppParser.yp"
4905
{
4906
# switch to verbatim mode
4907
_stateManager(STATE_VERBATIM);
4908
4909
# trace, if necessary
4910
warn "[Trace] $sourceFile, line $_[1][1]: Verbatim block starts.\n" if $flags{trace} & TRACE_PARAGRAPHS;
4911
4912
# check close hint: should be different from "1"
4913
_semerr($_[0], "A heredoc close hint should be different from \"1\".") if $_[1][0] eq '1';
4914
4915
# store close hint
4916
$specials{heredoc}=$_[1][0];
4917
}
4918
],
4919
[#Rule 75
4920
'verbatim', 4,
4921
sub
4922
#line 2638 "ppParser.yp"
4923
{
4924
# trace, if necessary
4925
warn "[Trace] $sourceFile, line $_[4][1]: Verbatim block completed.\n" if $flags{trace} & TRACE_PARAGRAPHS;
4926
4927
# back to default mode
4928
_stateManager(STATE_DEFAULT);
4929
4930
# delete the initial newline (which follows the opener but is no part of the block)
4931
shift(@{$_[3][0]});
4932
4933
# reply data
4934
my %hints=(nr=>++$directiveCounter);
4935
[
4936
[
4937
# opener directive
4938
[\%hints, DIRECTIVE_VERBATIM, DIRECTIVE_START],
4939
# the list of enclosed literals
4940
@{$_[3][0]},
4941
# final directive
4942
[\%hints, DIRECTIVE_VERBATIM, DIRECTIVE_COMPLETE]
4943
],
4944
$_[4][1]
4945
];
4946
}
4947
],
4948
[#Rule 76
4949
'@14-2', 0,
4950
sub
4951
#line 2666 "ppParser.yp"
4952
{
4953
# switch to text mode to allow *all* characters starting a variable value!
4954
_stateManager(STATE_TEXT);
4955
4956
# trace, if necessary
4957
warn "[Trace] $sourceFile, line $_[1][1]: Variable assignment starts.\n" if $flags{trace} & TRACE_PARAGRAPHS;
4958
}
4959
],
4960
[#Rule 77
4961
'variable_assignment', 4,
4962
sub
4963
#line 2674 "ppParser.yp"
4964
{
4965
# remove text directives and the final space (made from the final EOL)
4966
shift(@{$_[4][0]});
4967
pop(@{$_[4][0]});
4968
4969
# make the text contents a string and store it
4970
$variables{$_[1][0]}=join('', @{$_[4][0]});
4971
4972
# the variable might have been reset
4973
delete($variables{$_[1][0]}) if $variables{$_[1][0]}=~/^\s*$/;
4974
4975
# update variable checksum
4976
$varChecksum=sha1_base64(nfreeze(\%variables));
4977
4978
# propagate the setting to the stream, if necessary
4979
if ($flags{var2stream})
4980
{
4981
push(@{$resultStreamRef->[STREAM_TOKENS]}, [{}, DIRECTIVE_VARSET, DIRECTIVE_START, {var=>$_[1][0], value=>$variables{$_[1][0]}}]);
4982
4983
# update tag finish memory by the way
4984
_updateTagFinishMem(scalar(@{$resultStreamRef->[STREAM_TOKENS]}));
4985
}
4986
4987
# make the new variable setting available to embedded Perl code, if necessary
4988
if ($safeObject)
4989
{
4990
no strict 'refs';
4991
${join('::', ref($safeObject) ? $safeObject->root : 'main', $_[1][0])}=$variables{$_[1][0]};
4992
}
4993
4994
# trace, if necessary
4995
warn "[Trace] $sourceFile, line $_[4][1]: Variable assignment: \$$_[1][0]=$variables{$_[1][0]}.\n" if $flags{trace} & TRACE_PARAGRAPHS;
4996
4997
# flag this paragraph as internal
4998
['', $_[4][1]];
4999
}
5000
],
5001
[#Rule 78
5002
'@15-2', 0,
5003
sub
5004
#line 2714 "ppParser.yp"
5005
{
5006
# switch to comment mode
5007
_stateManager(STATE_COMMENT);
5008
5009
# trace, if necessary
5010
warn "[Trace] $sourceFile, line $_[1][1]: Comment starts.\n" if $flags{trace} & TRACE_PARAGRAPHS;
5011
}
5012
],
5013
[#Rule 79
5014
'comment', 5,
5015
sub
5016
#line 2722 "ppParser.yp"
5017
{
5018
# back to default mode
5019
_stateManager(STATE_DEFAULT);
5020
5021
# trace, if necessary
5022
warn "[Trace] $sourceFile, line $_[5][1]: Comment completed.\n" if $flags{trace} & TRACE_PARAGRAPHS;
5023
5024
# reply data, if necessary
5025
my %hints=(nr=>++$directiveCounter);
5026
$flags{skipcomments} ? [[()], $_[5][1]]
5027
: [
5028
[
5029
# opener directive
5030
[\%hints, DIRECTIVE_COMMENT, DIRECTIVE_START],
5031
# the list of enclosed literals
5032
@{$_[4][0]},
5033
# final directive
5034
[\%hints, DIRECTIVE_COMMENT, DIRECTIVE_COMPLETE]
5035
],
5036
$_[5][1]
5037
];
5038
}
5039
],
5040
[#Rule 80
5041
'@16-1', 0,
5042
sub
5043
#line 2748 "ppParser.yp"
5044
{
5045
# no mode switch necessary
5046
5047
# trace, if necessary
5048
warn "[Trace] $sourceFile, line $_[1][1]: Stream entry point starts.\n" if $flags{trace} & TRACE_PARAGRAPHS;
5049
}
5050
],
5051
[#Rule 81
5052
'dstream_entrypoint', 4,
5053
sub
5054
#line 2755 "ppParser.yp"
5055
{
5056
# no mode switch necessary
5057
5058
# trace, if necessary
5059
warn "[Trace] $sourceFile, line $_[5][1]: Stream entry point completed.\n" if $flags{trace} & TRACE_PARAGRAPHS;
5060
5061
# deactivate caching
5062
$flags{checksummed}=0;
5063
5064
# reply data as wished
5065
my $streamTitle=join('', @{$_[3][0]});
5066
unless (
5067
$flags{docstreaming}==DSTREAM_IGNORE
5068
or (
5069
$flags{docstreams2skip}
5070
and exists $flags{docstreams2skip}{$streamTitle}
5071
)
5072
)
5073
{
5074
# store stream title (both globally and locally)
5075
$resultStreamRef->[STREAM_DOCSTREAMS]{$streamTitle}=$flags{chapterDocstreams}{$streamTitle}=undef;
5076
5077
# special handling requested?
5078
if ($flags{docstreaming}==DSTREAM_HEADLINES)
5079
{
5080
# make this docstream entry point a headline
5081
# one level below the last real headline level
5082
my %hints=(nr=>++$directiveCounter, shortcut=>'');
5083
[
5084
[
5085
# opener directive (including headline level)
5086
[\%hints, DIRECTIVE_HEADLINE, DIRECTIVE_START, $flags{headlineLevel}+1],
5087
# the stream title becomes the "headline"
5088
$streamTitle,
5089
# final directive (including headline level again)
5090
[\%hints, DIRECTIVE_HEADLINE, DIRECTIVE_COMPLETE, $flags{headlineLevel}+1]
5091
],
5092
$_[5][1]
5093
];
5094
}
5095
# default handling
5096
else
5097
{
5098
my %hints=(nr=>++$directiveCounter);
5099
[
5100
[
5101
# directives
5102
[\%hints, DIRECTIVE_DSTREAM_ENTRYPOINT, DIRECTIVE_START, $streamTitle],
5103
],
5104
$_[5][1]
5105
];
5106
}
5107
}
5108
else
5109
{
5110
# configure parser to ignore eveything till the next stream entry point or headline
5111
# ... unless this is the *main* stream
5112
$flags{skipInput}=2 unless $streamTitle eq 'main';
5113
5114
# we have to supply something, but it should be nothing (note that this is a *paragraph*, so reply a *string*)
5115
['', $_[5][1]];
5116
}
5117
}
5118
],
5119
[#Rule 82
5120
'@17-1', 0,
5121
sub
5122
#line 2822 "ppParser.yp"
5123
{
5124
# temporarily activate number detection
5125
push(@specialStack, $specials{number});
5126
$specials{number}=1;
5127
}
5128
],
5129
[#Rule 83
5130
'@18-3', 0,
5131
sub
5132
#line 2828 "ppParser.yp"
5133
{
5134
# restore previous number detection mode
5135
$specials{number}=pop(@specialStack);
5136
5137
# switch to control mode
5138
_stateManager(STATE_CONTROL);
5139
5140
# trace, if necessary
5141
warn "[Trace] $sourceFile, line $_[3][1]: List shift ", $_[1][0]==LIST_SHIFT_RIGHT ? 'right' : 'left', " starts.\n" if $flags{trace} & TRACE_PARAGRAPHS;
5142
}
5143
],
5144
[#Rule 84
5145
'list_shift', 5,
5146
sub
5147
#line 2839 "ppParser.yp"
5148
{
5149
# back to default mode
5150
_stateManager(STATE_DEFAULT);
5151
5152
# trace, if necessary
5153
warn "[Trace] $sourceFile, line $_[5][1]: List shift ", $_[1][0]==LIST_SHIFT_RIGHT ? 'right' : 'left', " completed.\n" if $flags{trace} & TRACE_PARAGRAPHS;
5154
5155
# update related data
5156
if ($_[1][0]==LIST_SHIFT_RIGHT)
5157
{unshift(@olistLevels, 0) for (1..(defined $_[3][0] ? $_[3][0] : 1));}
5158
else
5159
{shift(@olistLevels) for (1..(defined $_[3][0] ? $_[3][0] : 1));}
5160
5161
# reset ordered list flag
5162
$flags{olist}=0;
5163
5164
# reply data
5165
[
5166
[
5167
# opener directive (no explicit closing)
5168
[{}, $_[1][0]==LIST_SHIFT_RIGHT ? DIRECTIVE_LIST_RSHIFT : DIRECTIVE_LIST_LSHIFT, DIRECTIVE_START, defined $_[3][0] ? $_[3][0] : 1],
5169
],
5170
$_[5][1]
5171
];
5172
}
5173
],
5174
[#Rule 85
5175
'list_shifter', 1,
5176
sub
5177
#line 2868 "ppParser.yp"
5178
{
5179
# reply a flag
5180
[LIST_SHIFT_RIGHT, $_[1][1]];
5181
}
5182
],
5183
[#Rule 86
5184
'list_shifter', 1,
5185
sub
5186
#line 2873 "ppParser.yp"
5187
{
5188
# reply a flag
5189
[LIST_SHIFT_LEFT, $_[1][1]];
5190
}
5191
],
5192
[#Rule 87
5193
'optional_literals', 0,
5194
sub
5195
#line 2881 "ppParser.yp"
5196
{
5197
# start a new, empty list and reply it
5198
[[], $lineNrs{$inHandle}];
5199
}
5200
],
5201
[#Rule 88
5202
'optional_literals', 1, undef
5203
],
5204
[#Rule 89
5205
'literals', 1, undef
5206
],
5207
[#Rule 90
5208
'literals', 2,
5209
sub
5210
#line 2891 "ppParser.yp"
5211
{
5212
# update token list and reply it
5213
push(@{$_[1][0]}, @{$_[2][0]});
5214
[$_[1][0], $_[2][1]];
5215
}
5216
],
5217
[#Rule 91
5218
'optional_literals_and_empty_lines', 0,
5219
sub
5220
#line 2900 "ppParser.yp"
5221
{
5222
# start a new, empty list and reply it
5223
[[], $lineNrs{$inHandle}];
5224
}
5225
],
5226
[#Rule 92
5227
'optional_literals_and_empty_lines', 1, undef
5228
],
5229
[#Rule 93
5230
'literals_and_empty_lines', 1, undef
5231
],
5232
[#Rule 94
5233
'literals_and_empty_lines', 2,
5234
sub
5235
#line 2910 "ppParser.yp"
5236
{
5237
# update token list and reply it
5238
push(@{$_[1][0]}, @{$_[2][0]});
5239
[$_[1][0], $_[2][1]];
5240
}
5241
],
5242
[#Rule 95
5243
'literal_or_empty_line', 1, undef
5244
],
5245
[#Rule 96
5246
'literal_or_empty_line', 1,
5247
sub
5248
#line 2920 "ppParser.yp"
5249
{
5250
# start a new token list and reply it
5251
[[$_[1][0]], $_[1][1]];
5252
}
5253
],
5254
[#Rule 97
5255
'literal', 1, undef
5256
],
5257
[#Rule 98
5258
'literal', 1,
5259
sub
5260
#line 2929 "ppParser.yp"
5261
{
5262
# start a new token list and reply it
5263
[[$_[1][0]], $_[1][1]];
5264
}
5265
],
5266
[#Rule 99
5267
'optional_basics', 0,
5268
sub
5269
#line 2937 "ppParser.yp"
5270
{
5271
# start a new, empty list and reply it
5272
[[], $lineNrs{$inHandle}];
5273
}
5274
],
5275
[#Rule 100
5276
'optional_basics', 1, undef
5277
],
5278
[#Rule 101
5279
'basics', 1, undef
5280
],
5281
[#Rule 102
5282
'basics', 2,
5283
sub
5284
#line 2947 "ppParser.yp"
5285
{
5286
# update token list and reply it
5287
push(@{$_[1][0]}, @{$_[2][0]});
5288
[$_[1][0], $_[2][1]];
5289
}
5290
],
5291
[#Rule 103
5292
'basic', 1, undef
5293
],
5294
[#Rule 104
5295
'basic', 1, undef
5296
],
5297
[#Rule 105
5298
'basic', 1, undef
5299
],
5300
[#Rule 106
5301
'elements', 1, undef
5302
],
5303
[#Rule 107
5304
'elements', 2,
5305
sub
5306
#line 2965 "ppParser.yp"
5307
{
5308
# update token list and reply it
5309
push(@{$_[1][0]}, @{$_[2][0]});
5310
[$_[1][0], $_[2][1]];
5311
}
5312
],
5313
[#Rule 108
5314
'element', 1,
5315
sub
5316
#line 2975 "ppParser.yp"
5317
{
5318
# start a new token list and reply it
5319
[[$_[1][0]], $_[1][1]];
5320
}
5321
],
5322
[#Rule 109
5323
'element', 1,
5324
sub
5325
#line 2980 "ppParser.yp"
5326
{
5327
# start a new token list and reply it
5328
[[$_[1][0]], $_[1][1]];
5329
}
5330
],
5331
[#Rule 110
5332
'element', 1,
5333
sub
5334
#line 2985 "ppParser.yp"
5335
{
5336
# flag that this paragraph uses variables (a cache hit will only be useful if variable settings will be unchanged)
5337
$flags{checksummed}[4]=1 unless exists $flags{checksummed} and not $flags{checksummed};
5338
5339
# start a new token list and reply it
5340
[[exists $variables{$_[1][0]} ? $variables{$_[1][0]} : join('', '$', $_[1][0])], $_[1][1]];
5341
}
5342
],
5343
[#Rule 111
5344
'element', 1,
5345
sub
5346
#line 2993 "ppParser.yp"
5347
{
5348
# flag that this paragraph uses variables (a cache hit will only be useful if variable settings will be unchanged)
5349
$flags{checksummed}[4]=1 unless exists $flags{checksummed} and not $flags{checksummed};
5350
5351
# start a new token list and reply it
5352
[[exists $variables{$_[1][0]} ? $variables{$_[1][0]} : join('', '$', "{$_[1][0]}")], $_[1][1]];
5353
}
5354
],
5355
[#Rule 112
5356
'element', 1,
5357
sub
5358
#line 3001 "ppParser.yp"
5359
{
5360
# start a new token list and reply it
5361
# (the passed stream is already a reference)
5362
[$_[1][0], $_[1][1]];
5363
}
5364
],
5365
[#Rule 113
5366
'element', 1, undef
5367
],
5368
[#Rule 114
5369
'element', 1, undef
5370
],
5371
[#Rule 115
5372
'element', 1, undef
5373
],
5374
[#Rule 116
5375
'optional_number', 0,
5376
sub
5377
#line 3014 "ppParser.yp"
5378
{[undef, $lineNrs{$inHandle}];}
5379
],
5380
[#Rule 117
5381
'optional_number', 1, undef
5382
],
5383
[#Rule 118
5384
'words', 1,
5385
sub
5386
#line 3021 "ppParser.yp"
5387
{
5388
# start a new token list and reply it
5389
[[$_[1][0]], $_[1][1]];
5390
}
5391
],
5392
[#Rule 119
5393
'words', 2,
5394
sub
5395
#line 3026 "ppParser.yp"
5396
{
5397
# update token list and reply it
5398
push(@{$_[1][0]}, $_[2][0]);
5399
[$_[1][0], $_[2][1]];
5400
}
5401
],
5402
[#Rule 120
5403
'words_or_spaces', 1,
5404
sub
5405
#line 3035 "ppParser.yp"
5406
{
5407
# start a new token list and reply it
5408
[[$_[1][0]], $_[1][1]];
5409
}
5410
],
5411
[#Rule 121
5412
'words_or_spaces', 2,
5413
sub
5414
#line 3040 "ppParser.yp"
5415
{
5416
# update token list and reply it
5417
push(@{$_[1][0]}, $_[2][0]);
5418
[$_[1][0], $_[2][1]];
5419
}
5420
],
5421
[#Rule 122
5422
'word_or_space', 1, undef
5423
],
5424
[#Rule 123
5425
'word_or_space', 1, undef
5426
],
5427
[#Rule 124
5428
'@19-1', 0,
5429
sub
5430
#line 3055 "ppParser.yp"
5431
{
5432
# trace, if necessary
5433
warn "[Trace] $sourceFile, line $_[1][1]: Tag $_[1][0] starts.\n" if $flags{trace} & TRACE_PARAGRAPHS;
5434
5435
# temporarily activate special "<" *as necessary*
5436
my $possible= (exists $macros{$_[1][0]} and $macros{$_[1][0]}->[2]) # macro: evaluate body flag;
5437
|| $tagsRef->{$_[1][0]}{__flags__}{__body__}; # tag with body;
5438
push(@specialStack, $specials{'<'}), $specials{'<'}=1 if $possible; # enable tag body, if necessary
5439
push(@specialStack, $possible); # flags what is on stack;
5440
5441
# temporarily activate specials "{" and "}" *as necessary*
5442
push(@specialStack, @specials{('{', '}')}), @specials{('{', '}')}=(1) x 2
5443
if (exists $macros{$_[1][0]} and %{$macros{$_[1][0]}->[0]}) # macro: evaluate declared options;
5444
|| $tagsRef->{$_[1][0]}{__flags__}{__options__}; # tag with options;
5445
5446
# deactivate boost
5447
$flags{noboost}=1;
5448
}
5449
],
5450
[#Rule 125
5451
'@20-3', 0,
5452
sub
5453
#line 3074 "ppParser.yp"
5454
{
5455
# reactivate boost
5456
$flags{noboost}=0;
5457
5458
# restore special states of "{" and "}", if necessary
5459
@specials{('{', '}')}=splice(@specialStack, -2, 2)
5460
if (exists $macros{$_[1][0]} and %{$macros{$_[1][0]}->[0]}) # macro: evaluate declared options;
5461
|| $tagsRef->{$_[1][0]}{__flags__}{__options__}; # tag with options;
5462
5463
# check options in general if declared mandatory
5464
if (
5465
not @{$_[3][0]}
5466
and exists $tagsRef->{$_[1][0]}
5467
and exists $tagsRef->{$_[1][0]}{options}
5468
and $tagsRef->{$_[1][0]}{options}==&TAGS_MANDATORY
5469
)
5470
{
5471
# display error message
5472
warn "\n\n[Fatal] $sourceFile, line $_[3][1]: Missing mandatory options of tag $_[1][0]\n";
5473
5474
# this is an syntactical error, stop parsing
5475
$_[0]->YYAbort;
5476
}
5477
}
5478
],
5479
[#Rule 126
5480
'tag', 5,
5481
sub
5482
#line 3099 "ppParser.yp"
5483
{
5484
# scopy
5485
my $ignore;
5486
5487
# trace, if necessary
5488
warn "[Trace] $sourceFile, line $_[5][1]: Tag $_[1][0] completed.\n" if $flags{trace} & TRACE_PARAGRAPHS;
5489
5490
# build parameter hash, if necessary
5491
my %pars;
5492
if (@{$_[3][0]})
5493
{
5494
# the list already consists of key/value pairs
5495
%pars=@{$_[3][0]}
5496
}
5497
5498
# Tag condition set?
5499
if (exists $pars{_cnd_})
5500
{
5501
# ok, if the condition was true or could not be evaluated, return just the body
5502
# (so that the tag or macro is ignored)
5503
unless (_evalTagCondition($pars{_cnd_}, $sourceFile, $_[5][1]))
5504
{return([[@{$_[5][0]} ? @{$_[5][0]} : ()], $_[5][1]]);}
5505
else
5506
{
5507
# strip off this special option before the tag or macro is furtherly processed
5508
delete $pars{_cnd_};
5509
}
5510
}
5511
5512
# tags require special handling
5513
unless (exists $macros{$_[1][0]})
5514
{
5515
# check tag body in general if declared mandatory
5516
if (
5517
not @{$_[5][0]}
5518
and exists $tagsRef->{$_[1][0]}
5519
and exists $tagsRef->{$_[1][0]}{body}
5520
and $tagsRef->{$_[1][0]}{body}==&TAGS_MANDATORY
5521
)
5522
{
5523
# display error message
5524
warn "[Fatal] $sourceFile, line $_[5][1]: Missing mandatory body of tag $_[1][0]\n";
5525
5526
# this is an syntactical error, stop parsing
5527
$_[0]->YYAbort;
5528
}
5529
5530
# invoke hook function, if necessary
5531
if (exists $tagsRef->{$_[1][0]} and exists $tagsRef->{$_[1][0]}{hook})
5532
{
5533
# make an option hash
5534
my $options={@{$_[3][0]}};
5535
5536
# call hook function (use eval() to guard yourself)
5537
my $rc;
5538
eval {$rc=&{$tagsRef->{$_[1][0]}{hook}}($_[1][1], $options, dclone($_[5][0]), $anchors, join('-', @headlineIds), $flags{headlinenr})};
5539
5540
# check result
5541
unless ($@)
5542
{
5543
{
5544
# semantic error?
5545
++$_semerr, last if $rc==PARSING_ERROR;
5546
5547
# syntactical error?
5548
$_[0]->YYAbort, last if $rc==PARSING_FAILED;
5549
5550
# tag to ignore, or even everything covered?
5551
$ignore=$rc, last if $rc==PARSING_IGNORE or $rc==PARSING_ERASE;
5552
5553
# update options (might be modified, and checking for a difference
5554
# might take more time then just copying the replied values)
5555
@{$_[3][0]}=%$options;
5556
5557
# all right?
5558
if ($rc==PARSING_OK)
5559
{
5560
# is this a tag that will invoke a finish hook?
5561
if (exists $tagsRef->{$_[1][0]}{finish})
5562
{
5563
# update number of tags to finish in the currently built stream section, if necessary
5564
$pendingTags->[1]++;
5565
5566
# Disable storage of a checksum. (A finish hook makes the paragraph depending
5567
# on something potentially outside the paragraph - the paragraph becomes dynamic.)
5568
$flags{checksummed}=0;
5569
}
5570
5571
# well done
5572
last;
5573
}
5574
5575
# or even superb?
5576
$_[0]->YYAccept, last if $rc==PARSING_COMPLETED;
5577
5578
# something is wrong here
5579
warn "[Warn] Tags $_[1][0] tag hook replied unexpected result $rc, ignored.\n";
5580
}
5581
}
5582
else
5583
{warn "[Warn] Error in tags $_[1][0] tag hook: $@\n"}
5584
5585
# rebuild parameter hash, if necessary
5586
if (@{$_[3][0]})
5587
{
5588
# the list already consists of key/value pairs
5589
%pars=@{$_[3][0]}
5590
}
5591
}
5592
}
5593
5594
# this might be a macro as well as a tag - so what?
5595
unless (exists $macros{$_[1][0]})
5596
{
5597
# update statistics
5598
$statistics{&DIRECTIVE_TAG}++;
5599
5600
# reply tag data as necessary
5601
unless (defined $ignore)
5602
{
5603
# supply a complete tag
5604
my %hints=(nr=>++$directiveCounter);
5605
[
5606
[
5607
# opener directive
5608
[\%hints, DIRECTIVE_TAG, DIRECTIVE_START, $_[1][0], \%pars, scalar(@{$_[5][0]})],
5609
# the list of enclosed literals, if any
5610
@{$_[5][0]} ? @{$_[5][0]} : (),
5611
# final directive
5612
[\%hints, DIRECTIVE_TAG, DIRECTIVE_COMPLETE, $_[1][0], \%pars, scalar(@{$_[5][0]})]
5613
],
5614
$_[5][1]
5615
];
5616
}
5617
elsif ($ignore==PARSING_IGNORE)
5618
{
5619
# supply the body, ignore the tag "envelope" ("hide" the tag)
5620
[
5621
[
5622
# the list of enclosed literals, if any
5623
@{$_[5][0]} ? @{$_[5][0]} : (),
5624
],
5625
$_[5][1]
5626
];
5627
}
5628
elsif ($ignore==PARSING_ERASE)
5629
{
5630
# reply nothing real
5631
[[()], $_[5][1]];
5632
}
5633
else
5634
{die "[BUG] Unhandled flag $ignore.";}
5635
}
5636
else
5637
{
5638
# flag that this paragraph uses macros (a cache hit will only be useful if macro definitions will have been unchanged)
5639
$flags{checksummed}[3]=1 unless exists $flags{checksummed} and not $flags{checksummed};
5640
5641
# this is a macro - resolve it!
5642
my $macro=$macros{$_[1][0]}->[1];
5643
5644
# fill in parameters
5645
foreach my $par (keys %{$macros{$_[1][0]}->[0]})
5646
{
5647
my $value= exists $pars{$par} ? $pars{$par}
5648
: defined $macros{$_[1][0]}->[0]{$par} ? $macros{$_[1][0]}->[0]{$par}
5649
: '';
5650
$macro=~s/__${par}__/$value/g;
5651
}
5652
5653
# Bodyless macros need special care - the parser already got the subsequent token to
5654
# recognize that the macro was complete. Now, the macro replacement is reinserted into
5655
# the stream where it will be read by the next lexer operation which is enforced when
5656
# the parser needs a token again - and this will happen after processing the already
5657
# received token which stood behind the bodyless macro. Letting the parser process the
5658
# read token this way, this token would be streamed (in most cases) *before* the macro
5659
# replacement, while it was intented to come after it. So, if we detect this case, we
5660
# move this token *behind* the macro replacement. As for the parser, we replace
5661
# this token by something streamed to "nothing", currently a special string declared
5662
# as "Word" token.
5663
my $delayedToken;
5664
unless (@{$_[5][0]})
5665
{
5666
# insert the current token behind the imaginary body
5667
$delayedToken=new PerlPoint::Parser::DelayedToken($_[0]->YYCurtok, $_[0]->YYCurval);
5668
5669
# set new dummy values to let the parser work on
5670
# (something without effect and valid everywhere a tag is)
5671
$_[0]->YYCurtok('Word');
5672
$_[0]->YYCurval([DUMMY_TOKEN, $_[0]->YYCurval->[1]]);
5673
}
5674
5675
# finally, pass the constructed text back to the input stream (by stack)
5676
_stackInput($_[0], (map {$_ eq '__body__' ? dclone($_[5][0]) : split(/(\n)/, $_)} split(/(__body__)/, $macro)), $delayedToken ? $delayedToken : ());
5677
5678
# reset the "end of input reached" flag if necessary
5679
$readCompletely=0 if $readCompletely;
5680
5681
# reply nothing real
5682
[[()], $_[5][1]];
5683
}
5684
}
5685
],
5686
[#Rule 127
5687
'optional_tagpars', 0,
5688
sub
5689
#line 3305 "ppParser.yp"
5690
{[[], $lineNrs{$inHandle}];}
5691
],
5692
[#Rule 128
5693
'optional_tagpars', 1, undef
5694
],
5695
[#Rule 129
5696
'used_tagpars', 3,
5697
sub
5698
#line 3311 "ppParser.yp"
5699
{
5700
# supply the parameters
5701
[$_[2][0], $_[3][1]];
5702
}
5703
],
5704
[#Rule 130
5705
'tagpars', 1, undef
5706
],
5707
[#Rule 131
5708
'tagpars', 3,
5709
sub
5710
#line 3320 "ppParser.yp"
5711
{
5712
# update parameter list
5713
push(@{$_[1][0]}, @{$_[3][0]});
5714
5715
# supply updated parameter list
5716
[$_[1][0], $_[3][1]];
5717
}
5718
],
5719
[#Rule 132
5720
'@21-1', 0,
5721
sub
5722
#line 3331 "ppParser.yp"
5723
{
5724
# backslashes should pass in tag options
5725
push(@specialStack, $lexerFlags{backsl});
5726
$lexerFlags{backsl}=LEXER_TOKEN;
5727
5728
# temporarily make "=" and quotes the only specials,
5729
# but take care to reset the remaining settings defined
5730
push(@specialStack, [(%specials)], $specials{'='});
5731
@specials{keys %specials}=(0) x scalar(keys %specials);
5732
@specials{('=', '"')}=(1, 1);
5733
}
5734
],
5735
[#Rule 133
5736
'@22-3', 0,
5737
sub
5738
#line 3343 "ppParser.yp"
5739
{
5740
# restore special "=" setting
5741
$specials{'='}=pop(@specialStack);
5742
}
5743
],
5744
[#Rule 134
5745
'tagpar', 5,
5746
sub
5747
#line 3348 "ppParser.yp"
5748
{
5749
# restore special settings
5750
%specials=@{pop(@specialStack)};
5751
5752
# restore backslash flag
5753
$lexerFlags{backsl}=pop(@specialStack);
5754
5755
# supply flag and value
5756
[[$_[1][0], $_[5][0]], $_[5][1]];
5757
}
5758
],
5759
[#Rule 135
5760
'tagvalue', 1, undef
5761
],
5762
[#Rule 136
5763
'tagvalue', 3,
5764
sub
5765
#line 3362 "ppParser.yp"
5766
{
5767
# build a string and supply it
5768
[join('', @{$_[2][0]}), $_[3][1]];
5769
}
5770
],
5771
[#Rule 137
5772
'optional_tagbody', 0,
5773
sub
5774
#line 3370 "ppParser.yp"
5775
{
5776
# if we are here, "<" *possibly* was marked to be a special - now it becomes what is was before
5777
# (take care the stack is filled correctly!)
5778
my $possible=pop(@specialStack); # was the body enabled?
5779
$specials{'<'}=pop(@specialStack) if $possible; # if so, restore the stack
5780
5781
# supply an empty result
5782
[[], $lineNrs{$inHandle}];
5783
}
5784
],
5785
[#Rule 138
5786
'@23-1', 0,
5787
sub
5788
#line 3380 "ppParser.yp"
5789
{
5790
# if we are here, "<" was marked to be a special - now it becomes what is was before
5791
# (take care the stack is filled correctly!)
5792
my $possible=pop(@specialStack); # can be ignored - surely the body was enabled!
5793
$specials{'<'}=pop(@specialStack); # restore the stack
5794
5795
# temporarily activate special ">"
5796
push(@specialStack, @specials{('>')});
5797
@specials{('>')}=1;
5798
}
5799
],
5800
[#Rule 139
5801
'optional_tagbody', 4,
5802
sub
5803
#line 3391 "ppParser.yp"
5804
{
5805
# reset ">" setting
5806
@specials{('>')}=pop(@specialStack);
5807
5808
# reply the literals
5809
[$_[3][0], $_[4][1]];
5810
}
5811
],
5812
[#Rule 140
5813
'@24-1', 0,
5814
sub
5815
#line 3402 "ppParser.yp"
5816
{
5817
# trace, if necessary
5818
warn "[Trace] $sourceFile, line $_[1][1]: Table starts.\n" if $flags{trace} & TRACE_PARAGRAPHS;
5819
5820
# check nesting
5821
_semerr($_[0], "$sourceFile, line $_[3][1]: Nested tables are not supported by this parser version.")
5822
if @tableSeparatorStack and not $flags{nestedTables};
5823
5824
# temporarily activate specials "{" and "}"
5825
push(@specialStack, @specials{('{', '}')});
5826
@specials{('{', '}')}=(1, 1);
5827
5828
# empty lines have to be ignored in tables
5829
push(@specialStack, $lexerFlags{el});
5830
$lexerFlags{el}=LEXER_IGNORE;
5831
5832
# deactivate boost
5833
$flags{noboost}=1;
5834
}
5835
],
5836
[#Rule 141
5837
'@25-3', 0,
5838
sub
5839
#line 3422 "ppParser.yp"
5840
{
5841
# reactivate boost
5842
$flags{noboost}=0;
5843
5844
# restore previous handling of empty lines
5845
$lexerFlags{el}=pop(@specialStack);
5846
5847
# restore special state of "{" and "}"
5848
@specials{('{', '}')}=splice(@specialStack, -2, 2);
5849
5850
# read parameters and adapt them, if necessary
5851
my %tagpars=@{$_[3][0]};
5852
5853
if (exists $tagpars{rowseparator})
5854
{
5855
$tagpars{rowseparator}=quotemeta($tagpars{rowseparator});
5856
$tagpars{rowseparator}="\n" if $tagpars{rowseparator} eq '\\\\n';
5857
}
5858
5859
# mark table start
5860
$tableColumns=0-(
5861
exists $tagpars{gracecr} ? $tagpars{gracecr}
5862
: (not exists $tagpars{rowseparator} or $tagpars{rowseparator} eq "\n") ? 1
5863
: 0
5864
);
5865
5866
# store specified column separator (or default)
5867
unshift(@tableSeparatorStack, [
5868
exists $tagpars{separator} ? quotemeta($tagpars{separator}) : '\|',
5869
exists $tagpars{rowseparator} ? $tagpars{rowseparator} : "\n",
5870
]);
5871
}
5872
],
5873
[#Rule 142
5874
'table', 6,
5875
sub
5876
#line 3455 "ppParser.yp"
5877
{
5878
# build parameter hash, if necessary
5879
my %pars;
5880
if (@{$_[3][0]})
5881
{
5882
# the list already consists of key/value pairs
5883
%pars=@{$_[3][0]}
5884
}
5885
5886
# Tag condition set?
5887
if (exists $pars{_cnd_})
5888
{
5889
# ok, if the condition was true or could not be evaluated,
5890
# stop processing of this tag (there is no body, so return an empty stream)
5891
unless (_evalTagCondition($pars{_cnd_}, $sourceFile, $_[6][1]))
5892
{return([[()], $_[6][1]]);}
5893
else
5894
{
5895
# strip off this special option before the tag or macro is furtherly processed
5896
delete $pars{_cnd_};
5897
}
5898
}
5899
5900
# add row separator information unless it was defined by the user itself
5901
$pars{rowseparator}='\n' unless exists $pars{rowseparator};
5902
$pars{rowseparator}='\\\\n' if $pars{rowseparator} eq '\\n';
5903
5904
# store nesting level information
5905
$pars{__nestingLevel__}=@tableSeparatorStack;
5906
5907
# If we are here and found anything in the table, it is
5908
# possible that a final row was closed and a new one opened
5909
# (e.g. at the end of the last table line, if rows are separated
5910
# by "\n"). Because the table is completed now, these tags can
5911
# be removed to get the common case of an opened but not yet
5912
# completed table cell.
5913
splice(@{$_[5][0]}, -4, 4) if @{$_[5][0]}
5914
and ref($_[5][0][-1]) eq 'ARRAY'
5915
and @{$_[5][0][-1]}==4
5916
and $_[5][0][-1][STREAM_DIR_TYPE] eq DIRECTIVE_TAG
5917
and $_[5][0][-1][STREAM_DIR_STATE] eq DIRECTIVE_START
5918
and $_[5][0][-1][STREAM_DIR_DATA] eq 'TABLE_COL';
5919
5920
# normalize table rows (no need of auto format)
5921
($pars{__titleColumns__}, $pars{__maxColumns__})=_normalizeTableRows($_[5][0], 0);
5922
5923
# warn user in case of potential row width conflicts
5924
warn qq([Warn] $sourceFile, line $_[1][1]: The maximum cell number per row ($pars{__maxColumns__}) was not detected in the first row (which has $pars{__titleColumns__} columns).\n) if $pars{__titleColumns__}<$pars{__maxColumns__} and not ($flags{display} & DISPLAY_NOWARN);
5925
5926
# reset column separator memory, mark table completed
5927
shift(@tableSeparatorStack);
5928
$tableColumns=0;
5929
5930
# reply data in a "tag envelope" (for backends)
5931
my ($hints1, $hints2, $hints3)=({nr=>++$directiveCounter}, {nr=>++$directiveCounter}, {nr=>++$directiveCounter});
5932
[
5933
[
5934
# opener directives
5935
[$hints1, DIRECTIVE_TAG, DIRECTIVE_START, 'TABLE', \%pars],
5936
[$hints2, DIRECTIVE_TAG, DIRECTIVE_START, 'TABLE_ROW'],
5937
[$hints3, DIRECTIVE_TAG, DIRECTIVE_START, 'TABLE_COL'],
5938
# the list of enclosed literals reduced by the final two, if any
5939
@{$_[5][0]} ? @{$_[5][0]} : (),
5940
# final directive
5941
[$hints3, DIRECTIVE_TAG, DIRECTIVE_COMPLETE, 'TABLE_COL'],
5942
[$hints2, DIRECTIVE_TAG, DIRECTIVE_COMPLETE, 'TABLE_ROW'],
5943
[$hints1, DIRECTIVE_TAG, DIRECTIVE_COMPLETE, 'TABLE', \%pars]
5944
],
5945
$_[6][1]
5946
];
5947
}
5948
],
5949
[#Rule 143
5950
'table_separator', 1,
5951
sub
5952
#line 3530 "ppParser.yp"
5953
{
5954
# update counter of completed table columns
5955
$tableColumns++;
5956
5957
# supply a simple seperator tag
5958
my %hints=(nr=>++$directiveCounter);
5959
[
5960
[
5961
[\%hints, DIRECTIVE_TAG, DIRECTIVE_COMPLETE, 'TABLE_COL'],
5962
$_[1][0] eq 'c' ? ()
5963
: (
5964
[{}, DIRECTIVE_TAG, DIRECTIVE_COMPLETE, 'TABLE_ROW'],
5965
[{}, DIRECTIVE_TAG, DIRECTIVE_START, 'TABLE_ROW'],
5966
),
5967
[\%hints, DIRECTIVE_TAG, DIRECTIVE_START, 'TABLE_COL'],
5968
],
5969
$_[1][1]
5970
];
5971
}
5972
],
5973
[#Rule 144
5974
'@26-1', 0,
5975
sub
5976
#line 3553 "ppParser.yp"
5977
{
5978
# switch to condition mode
5979
_stateManager(STATE_TABLE);
5980
5981
# trace, if necessary
5982
warn "[Trace] $sourceFile, line $_[1][1]: Table paragraph starts.\n" if $flags{trace} & TRACE_PARAGRAPHS;
5983
}
5984
],
5985
[#Rule 145
5986
'@27-4', 0,
5987
sub
5988
#line 3561 "ppParser.yp"
5989
{
5990
# store specified column separator
5991
unshift(@tableSeparatorStack, [quotemeta(join('', @{$_[3][0]})), "\n"]);
5992
}
5993
],
5994
[#Rule 146
5995
'table_paragraph', 7,
5996
sub
5997
#line 3566 "ppParser.yp"
5998
{
5999
# back to default mode
6000
_stateManager(STATE_DEFAULT);
6001
6002
# trace, if necessary
6003
warn "[Trace] $sourceFile, line $_[7][1]: Table paragraph completed.\n" if $flags{trace} & TRACE_PARAGRAPHS;
6004
6005
# reset column separator memory, mark table completed
6006
shift(@tableSeparatorStack);
6007
$tableColumns=0;
6008
6009
# build parameter hash (contains level information, which is always 1,
6010
# and various retranslation hints)
6011
my %pars=(
6012
__nestingLevel__ => 1,
6013
__paragraph__ => 1,
6014
separator => join('', @{$_[3][0]}),
6015
);
6016
6017
# If we are here and found anything in the table, a final row was
6018
# closed and a new one opened at the end of the last table line.
6019
# Because the table is completed now, the final opener tags can
6020
# be removed. This is done *here* and by pop() for acceleration.
6021
if (@{$_[6][0]}>4)
6022
{
6023
# delete final opener directives made by the final carriage return
6024
splice(@{$_[6][0]}, -2, 2);
6025
6026
# normalize table rows and autoformat headline fields
6027
($pars{__titleColumns__}, $pars{__maxColumns__})=_normalizeTableRows($_[6][0], 1);
6028
6029
# warn user in case of potential row width conflicts
6030
warn qq([Warn] $sourceFile, line $_[1][1]: The maximum cell number per row ($pars{__maxColumns__}) was not detected in the first row (which has $pars{__titleColumns__} columns).\n) if $pars{__titleColumns__}<$pars{__maxColumns__} and not ($flags{display} & DISPLAY_NOWARN);
6031
6032
# reply data in a "tag envelope" (for backends)
6033
my %hints=(nr=>++$directiveCounter);
6034
[
6035
[
6036
# opener directives (note that first row and column are already opened by the initial carriage return stream)
6037
[\%hints, DIRECTIVE_TAG, DIRECTIVE_START, 'TABLE', \%pars],
6038
[{}, DIRECTIVE_TAG, DIRECTIVE_START, 'TABLE_ROW'],
6039
[{}, DIRECTIVE_TAG, DIRECTIVE_START, 'TABLE_HL'],
6040
# the list of enclosed literals reduced by the final two, if any
6041
@{$_[6][0]} ? @{$_[6][0]} : (),
6042
# final directive
6043
[\%hints, DIRECTIVE_TAG, DIRECTIVE_COMPLETE, 'TABLE', \%pars]
6044
],
6045
$_[7][1]
6046
];
6047
}
6048
else
6049
{
6050
# empty table - reply nothing real
6051
[[()], $_[7][1]];
6052
}
6053
}
6054
],
6055
[#Rule 147
6056
'@28-1', 0,
6057
sub
6058
#line 3626 "ppParser.yp"
6059
{
6060
# switch to embedding mode saving the former state (including *all* special settings)
6061
push(@stateStack, $parserState);
6062
push(@specialStack, [%specials]);
6063
_stateManager(STATE_EMBEDDING);
6064
6065
# trace, if necessary
6066
warn "[Trace] $sourceFile, line $_[1][1]: Embedding starts.\n" if $flags{trace} & TRACE_PARAGRAPHS;
6067
6068
# Disable storage of a checksum. (Dynamic parts may change or have changed.
6069
# Static parts are static of course, but the filter settings may vary.)
6070
$flags{checksummed}=0;
6071
6072
# temporarily activate specials "{" and "}"
6073
push(@specialStack, @specials{('{', '}')});
6074
@specials{('{', '}')}=(1, 1);
6075
6076
# deactivate boost
6077
$flags{noboost}=1;
6078
}
6079
],
6080
[#Rule 148
6081
'@29-3', 0,
6082
sub
6083
#line 3647 "ppParser.yp"
6084
{
6085
# reactivate boost
6086
$flags{noboost}=0;
6087
6088
# restore special state of "{" and "}"
6089
@specials{('{', '}')}=splice(@specialStack, -2, 2);
6090
}
6091
],
6092
[#Rule 149
6093
'embedded', 6,
6094
sub
6095
#line 3655 "ppParser.yp"
6096
{
6097
# restore former parser state (including *all* special settings)
6098
_stateManager(pop(@stateStack));
6099
%specials=@{pop(@specialStack)};
6100
6101
# build parameter hash, if necessary
6102
my %pars;
6103
if (@{$_[3][0]})
6104
{
6105
# the list already consists of key/value pairs
6106
%pars=@{$_[3][0]}
6107
}
6108
6109
# set default language, if necessary
6110
$pars{lang}='pp' unless exists $pars{lang};
6111
6112
# Tag condition set?
6113
if (exists $pars{_cnd_})
6114
{
6115
# ok, if the condition was true or could not be evaluated,
6116
# stop processing of this tag (there is no body, so return an empty stream)
6117
unless (_evalTagCondition($pars{_cnd_}, $sourceFile, $_[6][1]))
6118
{return([[()], $_[6][1]]);}
6119
else
6120
{
6121
# strip off this special option before the tag or macro is furtherly processed
6122
delete $pars{_cnd_};
6123
}
6124
}
6125
6126
# did the user exclude files of the language the embedded source is written in?
6127
my $langExcluded=not (
6128
not $flags{filter} # no general language filter is defined, so all languages are allowed, or
6129
or lc($pars{lang}) eq 'pp' # this is a PerlPoint file, or
6130
or (
6131
exists $pars{lang} # there is a general language filter,
6132
and $pars{lang}=~/^$flags{filter}$/i # and it allows to include files of this language
6133
)
6134
);
6135
6136
# set import filter as necessary
6137
my $filterSet=_setImportFilter($_[0], \%pars);
6138
6139
# Input filter to call?
6140
if (
6141
not $langExcluded # files in the language of the embedded one are not excluded in general
6142
and exists $pars{ifilter} # and there is an import filter
6143
)
6144
{
6145
# Can we invoke the filter code?
6146
unless ($safeObject)
6147
{
6148
# What a pity - but probably the unfiltered source is not what the backend
6149
# expects, so we need to ignore the embedded code completely for now. As
6150
# usually, this is done without warning.
6151
return([[()], $_[6][1]]);
6152
}
6153
else
6154
{
6155
# OK, we can try to invoke the filter.
6156
6157
# inform user
6158
warn qq([Warn] $sourceFile, line $_[1][1]: Running input filter.\n) if $flags{trace} & TRACE_ACTIVE;
6159
6160
# update active contents base data, if necessary
6161
if ($flags{activeBaseData})
6162
{
6163
no strict 'refs';
6164
${join('::', ref($safeObject) ? $safeObject->root : 'main', 'PerlPoint')}=dclone($flags{activeBaseData});
6165
}
6166
6167
# We provide the text in a special variable @main::_ifilterText,
6168
# and the target type in a special variable $main::_ifilterType,
6169
# as well as the filename in a special var. $main::_ifilterFile.
6170
{
6171
no strict 'refs';
6172
@{join('::', ref($safeObject) ? $safeObject->root : 'main', '_ifilterText')}=@{$_[5][0]};
6173
${join('::', ref($safeObject) ? $safeObject->root : 'main', '_ifilterType')}=$pars{lang};
6174
${join('::', ref($safeObject) ? $safeObject->root : 'main', '_ifilterFile')}=$sourceFile;
6175
}
6176
6177
# run the filter and catch what it supplies
6178
$_[5][0]=[ref($safeObject) ? $safeObject->reval($pars{ifilter}) : eval(join(' ', '{package main; no strict;', $pars{ifilter}, '}'))];
6179
6180
# check result
6181
if ($@)
6182
{
6183
# inform user, if necessary
6184
_semerr($_[0], qq($sourceFile, line $_[1][1]: input filter failed: $@.));
6185
6186
# ignore this part
6187
return([[()], $_[6][1]]);
6188
}
6189
}
6190
}
6191
6192
# check if we have to stream this code
6193
if (not defined($filterSet) or $langExcluded)
6194
{
6195
# filter error occured, or the caller wants to skip the embedded code:
6196
# we have to supply something, but it should be nothing
6197
[[()], $_[6][1]];
6198
}
6199
elsif (lc($pars{lang}) eq 'pp')
6200
{
6201
# embedded PerlPoint - pass it back to the parser (by stack)
6202
_stackInput($_[0], split(/(\n)/, join('', @{$_[5][0]})));
6203
6204
# reset the "end of input reached" flag if necessary
6205
$readCompletely=0 if $readCompletely;
6206
6207
# we have to supply something, but it should be nothing
6208
[[()], $_[6][1]];
6209
}
6210
elsif (lc($pars{lang}) eq 'perl')
6211
{
6212
# This is embedded Perl code, anything passed really?
6213
# And does the caller want to evaluate the code?
6214
if (@{$_[5][0]} and $safeObject)
6215
{
6216
# update active contents base data, if necessary
6217
if ($flags{activeBaseData})
6218
{
6219
no strict 'refs';
6220
${join('::', ref($safeObject) ? $safeObject->root : 'main', 'PerlPoint')}=dclone($flags{activeBaseData});
6221
}
6222
6223
# make the code a string and evaluate it
6224
my $perl=join('', @{$_[5][0]});
6225
warn "[Trace] $sourceFile, line $_[6][1]: Evaluating this code:\n\n$perl\n\n\n" if $flags{trace} & TRACE_ACTIVE;
6226
6227
# ignore empty code
6228
if ($perl=~/\S/)
6229
{
6230
# well, there is something, evaluate it
6231
my $result=ref($safeObject) ? $safeObject->reval($perl) : eval(join(' ', '{package main; no strict;', $perl, '}'));
6232
6233
# check result
6234
if ($@)
6235
{_semerr($_[0], "$sourceFile, line $_[6][1]: embedded Perl code could not be evaluated: $@.");}
6236
else
6237
{
6238
# success - make the result part of the input stream, if any
6239
_stackInput($_[0], split(/(\n)/, $result)) if defined $result;
6240
}
6241
6242
# reset the "end of input reached" flag if necessary
6243
$readCompletely=0 if $readCompletely;
6244
}
6245
}
6246
6247
# we have to supply something, but it should be nothing
6248
[[()], $_[6][1]];
6249
}
6250
else
6251
{
6252
# reply data in a "tag envelope" (for backends)
6253
my %hints=(nr=>++$directiveCounter);
6254
[
6255
[
6256
# opener directive
6257
[\%hints, DIRECTIVE_TAG, DIRECTIVE_START, 'EMBED', \%pars],
6258
# the list of enclosed literals, if any
6259
@{$_[5][0]} ? @{$_[5][0]} : (),
6260
# final directive
6261
[\%hints, DIRECTIVE_TAG, DIRECTIVE_COMPLETE, 'EMBED', \%pars]
6262
],
6263
$_[6][1]
6264
];
6265
}
6266
}
6267
],
6268
[#Rule 150
6269
'@30-1', 0,
6270
sub
6271
#line 3830 "ppParser.yp"
6272
{
6273
# trace, if necessary
6274
warn "[Trace] $sourceFile, line $_[1][1]: Inclusion starts.\n" if $flags{trace} & TRACE_PARAGRAPHS;
6275
6276
# Disable storage of a checksum. (Files may change or have changed. Later on,
6277
# we could try to keep a files modification date unless it is a nested PerlPoint
6278
# source or a dynamic Perl part. For now, it seems to be sufficient that each file
6279
# is cached itself.)
6280
$flags{checksummed}=0;
6281
6282
# temporarily activate specials "{" and "}"
6283
push(@specialStack, @specials{('{', '}')});
6284
@specials{('{', '}')}=(1, 1);
6285
6286
# deactivate boost
6287
$flags{noboost}=1;
6288
}
6289
],
6290
[#Rule 151
6291
'included', 3,
6292
sub
6293
#line 3848 "ppParser.yp"
6294
{
6295
# scopies
6296
my ($errors, $originalPath);
6297
6298
# reactivate boost
6299
$flags{noboost}=0;
6300
6301
# restore special state of "{" and "}"
6302
@specials{('{', '}')}=splice(@specialStack, -2, 2);
6303
6304
# check parameters: type and filename should be set at least
6305
my %tagpars=@{$_[3][0]};
6306
$errors++, _semerr($_[0], "$sourceFile, line $_[3][1]: You forgot to specify the name of your included file.") unless exists $tagpars{file};
6307
6308
# set default type, if necessary
6309
$tagpars{type}='pp' unless exists $tagpars{type};
6310
6311
# Tag condition set?
6312
if (exists $tagpars{_cnd_})
6313
{
6314
# ok, if the condition was true or could not be evaluated,
6315
# stop processing of this tag (there is no body, so return an empty stream)
6316
unless (_evalTagCondition($tagpars{_cnd_}, $sourceFile, $_[3][1]))
6317
{return([[()], $_[3][1]]);}
6318
else
6319
{
6320
# strip off this special option before the tag or macro is furtherly processed
6321
delete $tagpars{_cnd_};
6322
}
6323
}
6324
6325
# search specified directories for the file if necessary
6326
unless (-e $tagpars{file})
6327
{
6328
# pathes are stored in an already prepared array @libraryPath
6329
foreach my $path (@libraryPath)
6330
{
6331
my $newname="$path/$tagpars{file}";
6332
warn "[Trace] $sourceFile, line $_[3][1]: Trying include file name $newname for $tagpars{file}.\n" if $flags{trace} & TRACE_SEMANTIC;
6333
$tagpars{file}=$newname, last if -e $newname;
6334
}
6335
}
6336
6337
# expand filename to avoid trouble by various names for the same file
6338
$tagpars{file}=catfile(abs_path(dirname($originalPath=$tagpars{file})), basename($tagpars{file}))
6339
or $errors++, semmerr("$sourceFile, line $_[3][1]: File name $tagpars{file} cannot be resolved.\n");
6340
6341
# smart inclusion?
6342
my $smart=1 if $tagpars{type}=~/^pp$/
6343
and exists $tagpars{smart} and $tagpars{smart}
6344
and exists $openedSourcefiles{$tagpars{file}};
6345
6346
# avoid circular source inclusion
6347
$errors++, _semerr($_[0], "$sourceFile, line $_[3][1]: Source file $originalPath was already opened before (full path: $tagpars{file}).") if $tagpars{type}=~/^pp$/
6348
and not $smart
6349
and grep($_ eq $tagpars{file}, @nestedSourcefiles);
6350
6351
6352
# PerlPoint headline offsets have to be positive numbers or certain strings
6353
$errors++, _semerr($_[0], "$sourceFile, line $_[3][1]: Invalid headline level offset $tagpars{headlinebase}, positive number or keywords BASE_LEVEL/CURRENT_LEVEL expected.") if $tagpars{type}=~/^pp$/i and exists $tagpars{headlinebase} and $tagpars{headlinebase}!~/^\d+$/ and $tagpars{headlinebase}!~/^(base|current)_level$/i;
6354
$tagpars{headlinebase}=$flags{headlineLevel} if exists $tagpars{headlinebase} and $tagpars{headlinebase}=~/^current_level$/i;
6355
$tagpars{headlinebase}=$flags{headlineLevel}-1 if exists $tagpars{headlinebase} and $tagpars{headlinebase}=~/^base_level$/i;
6356
6357
# all right?
6358
unless (defined $smart or defined $errors)
6359
{
6360
# check the filename
6361
if (-r $tagpars{file})
6362
{
6363
# store the files name and directory for later reference
6364
# (we could refer do that later, but using intermediate buffers
6365
# allows to keep the original values when switching the file in
6366
# background which happens with input filters)
6367
my $orgname=$tagpars{file};
6368
6369
# did the user exclude files of the language the embedded source is written in?
6370
my $typeExcluded=not (
6371
not $flags{filter} # no general language filter is defined, so all languages are allowed, or
6372
or lc($tagpars{type}) eq 'pp' # this is a PerlPoint file, or
6373
or (
6374
exists $tagpars{type} # there is a general language filter,
6375
and $tagpars{type}=~/^$flags{filter}$/i # and it allows to include files of this language
6376
)
6377
);
6378
6379
# try to set a set default import filter, if necessary
6380
if (exists $tagpars{import} and $tagpars{import} and $tagpars{import}!~/\D/)
6381
{
6382
# import format not set explicitly, scan file name for extension
6383
$tagpars{file}=~/\.(\w+)$/;
6384
$tagpars{import}=$1;
6385
6386
# success?
6387
delete $tagpars{import}, _semerr($_[0], qq($sourceFile, line $_[3][1]: could not determine import filter via file extension.)) unless $1;
6388
}
6389
6390
# arrange import as necessary
6391
my $filterSet=_setImportFilter($_[0], \%tagpars);
6392
6393
# Import filter to call?
6394
if (not $typeExcluded and exists $tagpars{ifilter})
6395
{
6396
# Can we invoke the filter code?
6397
unless ($safeObject)
6398
{
6399
# What a pity - but probably the unfiltered source is not what the backend
6400
# expects, so we need to ignore the embedded code completely for now. As
6401
# usually, this is done without warning.
6402
return([[()], $_[3][1]]);
6403
}
6404
else
6405
{
6406
# OK, we can try to invoke the filter.
6407
6408
# inform user
6409
warn qq([Warn] $sourceFile, line $_[1][1]: Running input filter.\n) if $flags{trace} & TRACE_ACTIVE;
6410
6411
# update active contents base data, if necessary
6412
if ($flags{activeBaseData})
6413
{
6414
no strict 'refs';
6415
${join('::', ref($safeObject) ? $safeObject->root : 'main', 'PerlPoint')}=dclone($flags{activeBaseData});
6416
}
6417
6418
# open original file
6419
open(my $orgHandle, $tagpars{file});
6420
binmode($orgHandle);
6421
6422
# We provide the text in a special variable @main::_ifilterText,
6423
# and the target type in a special variable $main::_ifilterType,
6424
# as well as the filename in a special var. $main::_ifilterFile.
6425
{
6426
no strict 'refs';
6427
@{join('::', ref($safeObject) ? $safeObject->root : 'main', '_ifilterText')}=<$orgHandle>;
6428
${join('::', ref($safeObject) ? $safeObject->root : 'main', '_ifilterType')}=$tagpars{type};
6429
${join('::', ref($safeObject) ? $safeObject->root : 'main', '_ifilterFile')}=$tagpars{file};
6430
}
6431
6432
# close original file
6433
close($orgHandle);
6434
6435
# run the filter in the files directory and catch what it supplies
6436
my $startDir=cwd();
6437
chdir(dirname($orgname));
6438
6439
my @ifiltered=ref($safeObject) ? $safeObject->reval($tagpars{ifilter}) : eval(join(' ', '{package main; no strict;', $tagpars{ifilter}, '}'));
6440
chdir($startDir);
6441
6442
# check result
6443
if ($@)
6444
{
6445
# inform user, if necessary
6446
_semerr($_[0], qq($sourceFile, line $_[1][1]: input filter failed: $@.));
6447
6448
# ignore this part
6449
return([[()], $_[3][1]]);
6450
}
6451
6452
# ok, now "replace" the original file by a temporary one
6453
my ($tmpHandle, $tmpFilename)=tempfile(UNLINK => ($flags{trace} & TRACE_TMPFILES ? 0 : 1));
6454
$tagpars{file}=$tmpFilename;
6455
6456
print $tmpHandle @ifiltered;
6457
close($tmpHandle);
6458
}
6459
}
6460
6461
# check for errors
6462
if (not defined $filterSet)
6463
{
6464
# we have to supply something - but it should be nothing
6465
[[()], $_[3][1]];
6466
}
6467
# check specified file type
6468
elsif ($tagpars{type}=~/^pp$/i)
6469
{
6470
# update nesting stack
6471
push(@nestedSourcefiles, $orgname);
6472
6473
# update source file nesting level hint
6474
_predeclareVariables({_SOURCE_LEVEL=>scalar(@nestedSourcefiles)});
6475
6476
# build a hash of variables to "localize"
6477
my ($localizedVars, $localizeAll)=({}, 0);
6478
if (exists $tagpars{localize})
6479
{
6480
# special setting?
6481
if ($tagpars{localize}=~/^\s*__ALL__\s*$/)
6482
{
6483
# store a copy of all existing variables
6484
$localizedVars=dclone(\%variables);
6485
$localizeAll=1;
6486
}
6487
else
6488
{
6489
# store values of all variables to localize (passed by a comma separated list)
6490
$localizedVars={map {$_=>$variables{$_}} split(/\s*,\s*/, $tagpars{localize})};
6491
}
6492
6493
# the source level variable needs to be corrected
6494
$localizedVars->{_SOURCE_LEVEL}-- if exists $localizedVars->{_SOURCE_LEVEL};
6495
}
6496
6497
# we include a PerlPoint document, switch input handle
6498
# (we intermediately have to close the original handle because of perl5.6.0 bugs)
6499
unshift(
6500
@inHandles, [
6501
tell($inHandle),
6502
$_[0]->{USER}->{INPUT},
6503
basename($sourceFile),
6504
$lineNrs{$inHandle},
6505
@flags{qw(headlineLevelOffset headlineLevel)},
6506
cwd(),
6507
$localizedVars, $localizeAll,
6508
]
6509
);
6510
close($inHandle);
6511
open($inHandle, $tagpars{file});
6512
binmode($inHandle);
6513
$_[0]->{USER}->{INPUT}='';
6514
$sourceFile=$tagpars{file};
6515
$lineNrs{$inHandle}=0;
6516
6517
# change directory with file
6518
chdir(dirname($orgname));
6519
6520
# open a new input stack
6521
unshift(@inputStack, []);
6522
6523
# headline level offset declared?
6524
$flags{headlineLevelOffset}=exists $tagpars{headlinebase} ? $tagpars{headlinebase} : 0;
6525
6526
# store the filename in the list of opened sources, to avoid circular reopening
6527
# (it would be more perfect to store the complete path, is there a module for this?)
6528
$openedSourcefiles{$tagpars{file}}=1;
6529
6530
# we have to supply something, but it should be nothing
6531
[[()], $_[3][1]];
6532
}
6533
elsif ($flags{filter} and $tagpars{type}!~/^(($flags{filter})|(?:parsed)?example)$/i)
6534
{
6535
# this file does not need to be included, nevertheless
6536
# we have to supply something - but it should be nothing
6537
[[()], $_[3][1]];
6538
}
6539
elsif ($tagpars{type}=~/^perl$/i)
6540
{
6541
# Does the caller want to evaluate code?
6542
if ($safeObject)
6543
{
6544
# update active contents base data, if necessary
6545
if ($flags{activeBaseData})
6546
{
6547
no strict 'refs';
6548
${join('::', ref($safeObject) ? $safeObject->root : 'main', 'PerlPoint')}=dclone($flags{activeBaseData});
6549
}
6550
6551
# evaluate the source code (for an unknown reason, we have to precede the constant by "&" here to work)
6552
warn "[Info] Evaluating included Perl code.\n" unless $flags{display} & &DISPLAY_NOINFO;
6553
my $result=ref($safeObject) ? $safeObject->rdo($tagpars{file})
6554
: eval
6555
{
6556
# enter user code namespace
6557
package main;
6558
# disable "strict" checks
6559
no strict;
6560
# excute user code
6561
my $result=do $tagpars{file};
6562
# check result ($! does not need to be checked, we checked file readability ourselves before)
6563
die $@ if $@;
6564
# reply provided result
6565
$result;
6566
};
6567
6568
# check result
6569
if ($@)
6570
{_semerr($_[0], "$sourceFile, line $_[3][1]: included Perl code could not be evaluated: $@.");}
6571
else
6572
{
6573
# success - make the result part of the input stream (by stack)
6574
_stackInput($_[0], split(/(\n)/, $result)) if defined $result;
6575
6576
# reset the "end of input reached" flag if necessary
6577
$readCompletely=0 if $readCompletely;
6578
}
6579
}
6580
6581
# we have to supply something, but it should be nothing
6582
[[()], $_[3][1]];
6583
}
6584
else
6585
{
6586
# we include anything else: provide the contents as it is,
6587
# declared as an "embedded" part
6588
# open(my $included, $tagpars{file});
6589
my $included=new IO::File;
6590
open($included, $tagpars{file});
6591
my @included=<$included>;
6592
close($included);
6593
6594
# in case the file was declared a (parsed) example, embed its contents as a (verbatim) block,
6595
# otherwise, include it as really embedded part (to be processed by a backend)
6596
if ($tagpars{type}=~/^(parsed)?example$/i)
6597
{
6598
# set paragraph type
6599
my $ptypeDirective=defined($1) ? DIRECTIVE_BLOCK : DIRECTIVE_VERBATIM;
6600
6601
# indent lines, if requested
6602
if (exists $tagpars{indent})
6603
{
6604
# check parameter
6605
unless ($tagpars{indent}=~/^\d+$/)
6606
{$errors++, _semerr($_[0], "$sourceFile, line $_[3][1]: Invalid indentation value of \"$tagpars{indent}\", please set up a number.");}
6607
else
6608
{
6609
# all right, indent
6610
my $indentation=' ' x $tagpars{indent};
6611
@included=map {"$indentation$_"} @included;
6612
}
6613
}
6614
6615
my %hints=(nr=>++$directiveCounter);
6616
[
6617
[
6618
# opener directive
6619
[\%hints, $ptypeDirective, DIRECTIVE_START],
6620
# the list of enclosed literals
6621
@included,
6622
# final directive
6623
[\%hints, $ptypeDirective, DIRECTIVE_COMPLETE]
6624
],
6625
$_[3][1]
6626
];
6627
}
6628
else
6629
{
6630
my %hints=(nr=>++$directiveCounter);
6631
[
6632
[
6633
# opener directive
6634
[\%hints, DIRECTIVE_TAG, DIRECTIVE_START, 'EMBED', {lang=>$tagpars{type}}],
6635
# the list of enclosed "literals", if any
6636
@included,
6637
# final directive
6638
[\%hints, DIRECTIVE_TAG, DIRECTIVE_COMPLETE, 'EMBED', {lang=>$tagpars{type}}]
6639
],
6640
$_[3][1]
6641
];
6642
}
6643
}
6644
}
6645
else
6646
{
6647
# file missing, simply inform user
6648
$errors++, _semerr($_[0], "$sourceFile, line $_[3][1]: File $tagpars{file} does not exist or cannot be read (current directory: ", cwd(), ").");
6649
6650
# we have to supply something, but it should be nothing
6651
[[()], $_[3][1]];
6652
}
6653
}
6654
else
6655
{
6656
# we have to supply something, but it should be nothing
6657
[[()], $_[3][1]];
6658
}
6659
}
6660
],
6661
[#Rule 152
6662
'@31-1', 0,
6663
sub
6664
#line 4219 "ppParser.yp"
6665
{
6666
# switch to definition mode
6667
_stateManager(STATE_DEFINITION);
6668
6669
# trace, if necessary
6670
warn "[Trace] $sourceFile, line $_[1][1]: Macro definition starts.\n" if $flags{trace} & TRACE_PARAGRAPHS;
6671
}
6672
],
6673
[#Rule 153
6674
'@32-3', 0,
6675
sub
6676
#line 4227 "ppParser.yp"
6677
{
6678
# deactivate boost
6679
$flags{noboost}=1;
6680
}
6681
],
6682
[#Rule 154
6683
'@33-5', 0,
6684
sub
6685
#line 4232 "ppParser.yp"
6686
{
6687
# reactivate boost
6688
$flags{noboost}=0;
6689
}
6690
],
6691
[#Rule 155
6692
'@34-7', 0,
6693
sub
6694
#line 4237 "ppParser.yp"
6695
{
6696
# disable all specials to get the body as a plain text
6697
@specials{keys %specials}=(0) x scalar(keys %specials);
6698
}
6699
],
6700
[#Rule 156
6701
'alias_definition', 9,
6702
sub
6703
#line 4242 "ppParser.yp"
6704
{
6705
# "text" already switched back to default mode (and disabled specials [{}:])
6706
6707
# trace, if necessary
6708
warn "[Trace] $sourceFile, line $_[7][1]: Macro definition completed.\n" if $flags{trace} & TRACE_PARAGRAPHS;
6709
6710
# check spelling (only accept capitals and underscores in alias names, just like in tags)
6711
if ($_[3][0]=~/[a-z]/)
6712
{
6713
warn "[Warn] $sourceFile, line $_[3][1]: Macro \"\\$_[3][0]\" is stored as ", uc("\\$_[3][0]"), ".\n" unless $flags{display} & DISPLAY_NOWARN;
6714
$_[3][0]=uc($_[3][0]);
6715
}
6716
6717
# build macro text
6718
shift(@{$_[9][0]}); pop(@{$_[9][0]});
6719
my $macro=join('', @{$_[9][0]});
6720
6721
# anything specified?
6722
if ($macro=~/^\s*$/)
6723
{
6724
# nothing defined, should this line cancel a previous definition?
6725
if (exists $macros{$_[3][0]})
6726
{
6727
# cancel macro
6728
delete $macros{$_[3][0]};
6729
6730
# trace, if necessary
6731
warn "[Trace] $sourceFile, line $_[7][1]: Macro \"$_[3][0]\" is cancelled.\n" if $flags{trace} & TRACE_SEMANTIC;
6732
6733
# update macro checksum
6734
$macroChecksum=sha1_base64(nfreeze(\%macros));
6735
}
6736
else
6737
{
6738
# trace, if necessary
6739
warn "[Trace] $sourceFile, line $_[7][1]: Empty macro \"$_[3][0]\" is ignored.\n" if $flags{trace} & TRACE_SEMANTIC;
6740
}
6741
}
6742
else
6743
{
6744
# ok, this is a new definition - get all used parameters
6745
my %pars;
6746
@pars{($macro=~/__([^_\\]+)__/g)}=();
6747
6748
# store default values of options, if necessary
6749
if (@{$_[5][0]})
6750
{
6751
# the list already consists of key/value pairs
6752
my %defaults=@{$_[5][0]};
6753
exists $pars{$_} and $pars{$_}=$defaults{$_} for keys %defaults;
6754
}
6755
6756
# tag body wildcard is no parameter
6757
my $bodyFlag=exists $pars{body} ? 1 : 0;
6758
delete $pars{body};
6759
6760
# make guarded underscores just underscores
6761
$macro=~s/\\_//g;
6762
6763
# store name, parameters (and their defaults, if any),
6764
# macro text and body flag
6765
$macros{$_[3][0]}=[\%pars, $macro, $bodyFlag];
6766
6767
# update macro checksum
6768
$macroChecksum=sha1_base64(nfreeze(\%macros));
6769
}
6770
6771
# we have to supply something, but it should be nothing
6772
# (this is a paragraph, so reply a plain string)
6773
['', $_[11][1]];
6774
}
6775
]
6776
],
6777
@_);
6778
bless($self,$class);
6779
}
6780
6781
#line 4317 "ppParser.yp"
6782
6783
6784
6785
# ------------------------------------------
6786
# Internal function: input stack management.
6787
# ------------------------------------------
6788
sub _stackInput
6789
{
6790
# get parameters
6791
my ($parser, @lines)=@_;
6792
6793
# declare variable
6794
my (@waiting);
6795
6796
# the current input line becomes the last line to read in this set
6797
# (this way, we arrange it that additional text is exactly placed where its generator tag or macro stood,
6798
# without Ils confusion)
6799
push(@lines, (defined $parser->{USER}->{INPUT} and $parser->{USER}->{INPUT}) ? $parser->{USER}->{INPUT} : ());
6800
6801
# combine line parts to lines completed by a trailing newline
6802
# (additionally, take into account that there might be mixed references which have to be stored unchanged)
6803
{
6804
my $lineBuffer='';
6805
foreach my $line (@lines)
6806
{
6807
if (ref($line))
6808
{
6809
# push collected string and current reference
6810
push(@waiting, length($lineBuffer) ? $lineBuffer : (), $line);
6811
6812
# reset line buffer
6813
$lineBuffer='';
6814
6815
# next turn
6816
next;
6817
}
6818
6819
# compose a string ...
6820
$lineBuffer.=$line;
6821
6822
# ... until a newline was found
6823
push(@waiting, $lineBuffer), $lineBuffer='' if $line eq "\n";
6824
}
6825
push(@waiting, $lineBuffer) if length($lineBuffer);
6826
}
6827
6828
# get next line to read
6829
my $newInputLine=shift(@waiting);
6830
6831
# update (innermost) input stack
6832
unshift(@{$inputStack[0]}, @waiting);
6833
6834
# update line memory (flag that this was an expanded line by adding a third parameter)
6835
unshift(@inLine, [length($newInputLine)+length('exp.: '), "exp.: $newInputLine", 1]);
6836
6837
# make the new top line the current input
6838
$parser->{USER}->{INPUT}=$newInputLine;
6839
}
6840
6841
6842
6843
# a pattern lookup table for certain specials, used by the lexer (should be scoped to it
6844
# but indentation of a long function takes time ...)
6845
my %specials2patterns;
6846
@specials2patterns{'colon', 'number', '-'}=(':', '0-9', '\-');
6847
6848
6849
# -----------------------------
6850
# Internal function: the lexer.
6851
# -----------------------------
6852
sub _lexer
6853
{
6854
# get parameters
6855
my ($parser)=@_;
6856
6857
# scan for unlexed EOL´s which should be ignored
6858
while (
6859
$parser->{USER}->{INPUT}
6860
and $parser->{USER}->{INPUT}=~/^\n/
6861
and (
6862
$lexerFlags{eol}==LEXER_IGNORE
6863
or (
6864
@tableSeparatorStack
6865
and $tableSeparatorStack[0][1] eq "\n"
6866
and $tableColumns<0
6867
)
6868
)
6869
)
6870
{
6871
# trace, if necessary
6872
warn "[Trace] Lexer: Ignored EOL in line $lineNrs{$inHandle}.\n" if $flags{trace} & TRACE_LEXER;
6873
6874
# remove the ignored newline
6875
$parser->{USER}->{INPUT}=~s/^\n//;
6876
6877
# update column counter, if necessary
6878
$tableColumns++ if @tableSeparatorStack and $tableSeparatorStack[0][1] eq "\n" and $tableColumns<0;
6879
}
6880
6881
# get next symbol
6882
unless ($parser->{USER}->{INPUT})
6883
{
6884
# update line memory (removed handled lines, both original and expanded ones)
6885
# (use a do block to perform the operation once in any case, see perlsyn)
6886
do {shift(@inLine)} until not @inLine or @{$inLine[0]}==2;
6887
6888
{
6889
# will the next line be get from the input stack instead of from a real file?
6890
my $lineFromStack=scalar(@{$inputStack[0]});
6891
6892
# reset stack line buffer, if necessary
6893
undef @previousStackLines unless $lineFromStack;
6894
6895
# get next input line
6896
unless (
6897
(@{$inputStack[0]} and ($parser->{USER}->{INPUT}=shift(@{$inputStack[0]}) or 1))
6898
or (defined($inHandle) and $parser->{USER}->{INPUT}=<$inHandle>)
6899
)
6900
{
6901
# was this a nested source?
6902
unless (@inHandles)
6903
{
6904
# This was the base document: should we insert a final additional token?
6905
# (In case we recognize the end of a document source when there is still a
6906
# paragraph filter pending, supply as many "empty lines" as necessary to let
6907
# the parser recognize the filtered paragraph is completed. Possibly a loop
6908
# detection should be added to avoid endless ping-pong.)
6909
$readCompletely=1,
6910
(($flags{trace} & TRACE_LEXER) and warn("[Trace] Lexer: Final Empty_line in line $lineNrs{$inHandle}.\n")),
6911
return('Empty_line', ['', $lineNrs{$inHandle}]) unless $readCompletely and not $flags{virtualParagraphStart};
6912
6913
# well done
6914
return('', [undef, -1]);
6915
}
6916
else
6917
{
6918
# we finished a nested source: close it and restore
6919
# things to continue reading of enclosing file
6920
my ($helper1, $helper2, $helper3, $localizedVars, $localizedAll);
6921
(
6922
$helper1,
6923
$parser->{USER}->{INPUT},
6924
$sourceFile,
6925
$helper2,
6926
@flags{qw(headlineLevelOffset headlineLevel)},
6927
$helper3,
6928
$localizedVars, $localizedAll,
6929
)=@{shift(@inHandles)};
6930
$lineNrs{$inHandle}=$helper2-1; # -1 to compensate the subsequent increment
6931
6932
# back to envelopes directory
6933
chdir($helper3);
6934
6935
# reopen envelope file
6936
close($inHandle);
6937
$inHandle=new IO::File;
6938
open($inHandle, $sourceFile);
6939
binmode($inHandle);
6940
seek($inHandle, $helper1, 0);
6941
6942
# switch back to envelopes input stack
6943
shift(@inputStack);
6944
6945
# update nesting stack
6946
pop(@nestedSourcefiles);
6947
6948
# update source file nesting level hint
6949
_predeclareVariables({_SOURCE_LEVEL=>scalar(@nestedSourcefiles)});
6950
6951
# restore variables as necessary
6952
if ($localizedAll)
6953
{
6954
# Do we have to take care of the stream?
6955
if ($flags{var2stream})
6956
{
6957
# stream variable reset
6958
push(@{$resultStreamRef->[STREAM_TOKENS]}, [{}, DIRECTIVE_VARRESET, DIRECTIVE_START]);
6959
6960
# update tag finish memory
6961
_updateTagFinishMem(scalar(@{$resultStreamRef->[STREAM_TOKENS]}));
6962
6963
# restore former variables completely, overwriting current settings
6964
# (and propagating them into the stream again)
6965
undef %variables;
6966
_predeclareVariables({$_=>$localizedVars->{$_}}, 1) foreach sort keys %$localizedVars;
6967
}
6968
else
6969
{
6970
# ok, the stream does not take notice of this operation, so it can be performed quicker
6971
%variables=%$localizedVars;
6972
}
6973
}
6974
elsif (!$localizedAll and %$localizedVars)
6975
{
6976
# handle each localized variable
6977
foreach my $var (keys %$localizedVars)
6978
{
6979
# restore old value in parser and stream context, if necessary
6980
_predeclareVariables({$var=>$localizedVars->{$var}}, 1)
6981
if $localizedVars->{$var} ne $variables{$var};
6982
}
6983
}
6984
}
6985
}
6986
6987
# update stack line buffers, if necessary
6988
if ($lineFromStack)
6989
{
6990
# "rotate" buffers (necessary because there are various return points following,
6991
# so there will be not exactly one final point where we could save the current
6992
# line value in a scalar buffer)
6993
$previousStackLines[0]=$previousStackLines[1];
6994
$previousStackLines[1]=$parser->{USER}->{INPUT};
6995
}
6996
6997
# reference found on stack?
6998
if ($lineFromStack and ref($parser->{USER}->{INPUT}))
6999
{
7000
# get the reference
7001
my @refLexed=_refLexed($parser);
7002
7003
# unless the item was a newline, we can use it directly
7004
# (but the context for newline evaluation might have changed between the
7005
# point of delaying and now)
7006
return @refLexed unless $refLexed[0] eq 'Empty_line';
7007
7008
# ok, this has to be parsed *again* (because the paragraph/special characters
7009
# context *now* might be different from that that was present when we stacked
7010
# the item)
7011
($parser->{USER}->{INPUT}, $lineNrs{$inHandle})=@{$refLexed[1]};
7012
}
7013
7014
# update line counter, if necessary
7015
$lineNrs{$inHandle}++ unless $lineFromStack;
7016
7017
# ignore this line if wished (take conditions and docstreams into account)
7018
$parser->{USER}->{INPUT}='', redo if $flags{skipInput}==1 and $parser->{USER}->{INPUT}!~/^\?/;
7019
$parser->{USER}->{INPUT}='', redo if $flags{skipInput}==2 and $parser->{USER}->{INPUT}!~/^[~=]/;
7020
7021
# if we are here, we can leave the skip mode (both condition and docstream one)
7022
$flags{skipInput}=0;
7023
7024
# we read a new line (or something from stack)
7025
unshift(@inLine, [length($parser->{USER}->{INPUT})+length('org.: '), "org.: $parser->{USER}->{INPUT}"]);
7026
7027
unless ($lineFromStack)
7028
{
7029
# add a line update hint
7030
if ($flags{linehints})
7031
{
7032
push(@{$resultStreamRef->[STREAM_TOKENS]}, [{}, DIRECTIVE_NEW_LINE, DIRECTIVE_START, {file=>$sourceFile, line=>$lineNrs{$inHandle}}]);
7033
7034
# update tag finish memory by the way
7035
_updateTagFinishMem(scalar(@{$resultStreamRef->[STREAM_TOKENS]}));
7036
}
7037
7038
# remove TRAILING whitespaces, but keep newlines (if any)
7039
{
7040
my $newline=($parser->{USER}->{INPUT}=~/\n$/m);
7041
$parser->{USER}->{INPUT}=~s/\s*$//;
7042
$parser->{USER}->{INPUT}=join('', $parser->{USER}->{INPUT}, "\n") if $newline;
7043
}
7044
}
7045
7046
# scan for empty lines as necessary
7047
if ($parser->{USER}->{INPUT}=~/^$/)
7048
{
7049
# update the checksum flags
7050
$flags{checksum}=1 if $flags{cache} & CACHE_ON;
7051
7052
# trace, if necessary
7053
warn "[Trace] Lexer: Empty_line in line $lineNrs{$inHandle}", $lexerFlags{el}==LEXER_IGNORE ? ' is ignored' : '', ".\n" if $flags{trace} & TRACE_LEXER;
7054
7055
# update input line
7056
$parser->{USER}->{INPUT}='';
7057
7058
# sometimes empty lines have no special meaning
7059
shift(@inLine), redo if $lexerFlags{el}==LEXER_IGNORE;
7060
7061
# but sometimes they are very special
7062
return('Empty_line', ["\n", $lineNrs{$inHandle}]);
7063
}
7064
else
7065
{
7066
# disable caching for embedded code containing empty lines
7067
$flags{checksummed}=0 if $specials{embedded};
7068
7069
# this may be the first line of a new paragraph to be checksummed
7070
if (
7071
($flags{cache} & CACHE_ON)
7072
and $flags{checksum}
7073
and not $lineFromStack
7074
and (not $specials{heredoc} or $specials{heredoc} eq '1')
7075
and not @tableSeparatorStack
7076
and not $specials{embedded}
7077
)
7078
{
7079
# handle $/ locally
7080
local($/);
7081
7082
# update statistics
7083
$statistics{cache}[0]++;
7084
7085
# well, switch to paragraph mode (depending on the paragraph type)!
7086
if ($parser->{USER}->{INPUT}=~/^<<(\w+)/)
7087
{$/="\n$1";}
7088
elsif ($parser->{USER}->{INPUT}=~/^(?
7089
{$/="\n\\END_TABLE";}
7090
else
7091
{$/='';}
7092
7093
# store current position
7094
my $lexerPosition=tell($inHandle);
7095
7096
# read *current* paragraph completely (take care - we may have read it completely yet!)
7097
seek($inHandle, $lexerPosition-length($parser->{USER}->{INPUT}), 0) unless $parser->{USER}->{INPUT}=~/^<<(\w+)/ or $parser->{USER}->{INPUT}=~/^(?
7098
my $paragraph=<$inHandle>;
7099
$paragraph=join('', $parser->{USER}->{INPUT}, $paragraph) if $parser->{USER}->{INPUT}=~/^<<(\w+)/ or $parser->{USER}->{INPUT}=~/^(?
7100
7101
# count the lines in the paragraph read
7102
my $plines=0;
7103
$plines++ while $paragraph=~/(\n)/g;
7104
$plines-- unless $parser->{USER}->{INPUT}=~/^<<(\w+)/ or $parser->{USER}->{INPUT}=~/^(?
7105
7106
# remove trailing whitespaces (to avoid checksumming them)
7107
$paragraph=~s/\n+$//;
7108
7109
# anything interesting found?
7110
if (defined $paragraph)
7111
{
7112
# build checksum (of paragraph *and* headline level offset)
7113
my $checksum=sha1_base64(join('+', exists $flags{headlineLevelOffset} ? $flags{headlineLevelOffset} : 0, $paragraph));
7114
7115
# warn "---> Searching checksum for this paragraph:\n-----\n$paragraph\n- by $checksum --\n";
7116
# check paragraph to be known
7117
if (
7118
exists $checksums->{$sourceFile}
7119
and exists $checksums->{$sourceFile}{$checksum}
7120
and (
7121
not defined $checksums->{$sourceFile}{$checksum}[3]
7122
or $checksums->{$sourceFile}{$checksum}[3] eq $macroChecksum
7123
)
7124
and (
7125
not defined $checksums->{$sourceFile}{$checksum}[4]
7126
or $checksums->{$sourceFile}{$checksum}[4] eq $varChecksum
7127
)
7128
)
7129
{
7130
# Do *not* reset the checksum flag for new checksums - we already read the
7131
# empty lines, and a new paragraph may follow! *But* deactivate the current
7132
# checksum to avoid multiple storage - we already stored it, right?
7133
$flags{checksummed}=0;
7134
7135
# reset input buffer - it is all handled (take care to remove a final newline
7136
# if the paragraph was closed by a string - this would normally be read in a
7137
# per line processing, but it remained in the file in paragraph mode)
7138
$/="\n";
7139
scalar(<$inHandle>) if $parser->{USER}->{INPUT}=~/^<<(\w+)/ or $parser->{USER}->{INPUT}=~/^(?
7140
$parser->{USER}->{INPUT}='';
7141
7142
# warn "===========> PARAGRAPH CACHE HIT!! ($lineNrs{$inHandle}/$sourceFile/$checksum) <=================\n$paragraph-----\n";
7143
# use Data::Dumper; warn Dumper($checksums->{$sourceFile}{$checksum});
7144
7145
# update statistics
7146
$statistics{cache}[1]++;
7147
7148
# update line counter
7149
# warn "----> Old line: $lineNrs{$inHandle}\n";
7150
$lineNrs{$inHandle}+=$plines;
7151
# warn "----> New line: $lineNrs{$inHandle}\n";
7152
7153
# update anchors
7154
$anchors->add($_, $checksums->{$sourceFile}{$checksum}[5]{$_}, $flags{headlinenr})
7155
foreach keys %{$checksums->{$sourceFile}{$checksum}[5]};
7156
7157
# The next steps depend - follow the provided hint. We may have to reinvoke
7158
# the parser to restore a state.
7159
# perl 5.6 # unless (exists $checksums->{$sourceFile}{$checksum}[2])
7160
unless (defined $checksums->{$sourceFile}{$checksum}[2])
7161
{
7162
# direct case - add the already known part directly to the stream
7163
push(@{$resultStreamRef->[STREAM_TOKENS]}, @{$checksums->{$sourceFile}{$checksum}[0]});
7164
7165
# update tag finish memory
7166
_updateTagFinishMem(scalar(@{$resultStreamRef->[STREAM_TOKENS]}));
7167
7168
# Well done this paragraph - go on!
7169
shift(@inLine);
7170
redo;
7171
}
7172
else
7173
{
7174
# more complex case - reinvoke the parser to update its states
7175
return($checksums->{$sourceFile}{$checksum}[2], [dclone($checksums->{$sourceFile}{$checksum}[0]), $lineNrs{$inHandle}]);
7176
}
7177
}
7178
7179
# flag that we are going to build an associated stream
7180
$flags{checksummed}=[$checksum, scalar(@{$resultStreamRef->[STREAM_TOKENS]}), $plines];
7181
# warn "---> Started checksumming for\n-----\n$paragraph\n---(", $plines+1, " line(s))\n";
7182
7183
# restart anchor logging
7184
$anchors->checkpoint(1);
7185
}
7186
7187
# reset file pointer
7188
seek($inHandle, $lexerPosition, 0);
7189
}
7190
7191
# update the checksum flag: we are *within* a paragraph, do not checksum
7192
# until we reach the next empty line
7193
$flags{checksum}=0;
7194
}
7195
7196
# detect things at the beginning of a *real* line at the beginning of a paragraph
7197
# (which nevertheless might have been stacked)
7198
if ( not $lineFromStack
7199
or ( defined $previousStackLines[0]
7200
and not ref($previousStackLines[0])
7201
and $previousStackLines[0]=~/\n$/
7202
)
7203
)
7204
{
7205
my @rc=_lineStartResearch($parser);
7206
return(@rc) if shift(@rc);
7207
}
7208
}
7209
}
7210
7211
# trace, if necessary
7212
warn '[Trace] Lexing ', ref($parser->{USER}->{INPUT}) ? 'a prepared part' : qq("$parser->{USER}->{INPUT}"), ".\n" if $flags{trace} & TRACE_LEXER;
7213
7214
# Reference found? (Usually placed by _stackInput().)
7215
return _refLexed($parser) if ref($parser->{USER}->{INPUT});
7216
7217
# if the paragraph was just filtered, there might be certain operations to perform
7218
# (as usual at the beginning of a new paragraph)
7219
if ($parserState==STATE_PFILTERED)
7220
{
7221
my @rc=_lineStartResearch($parser);
7222
return(@rc) if shift(@rc);
7223
}
7224
7225
# scan for heredoc close hints
7226
if ($specials{heredoc} and $specials{heredoc} ne '1' and $parser->{USER}->{INPUT}=~/^($specials{heredoc})$/)
7227
{
7228
# trace, if necessary
7229
warn "[Trace] Lexer: Heredoc close hint $1 in line $lineNrs{$inHandle}.\n" if $flags{trace} & TRACE_LEXER;
7230
7231
# update input line
7232
$parser->{USER}->{INPUT}='';
7233
7234
# reset heredoc setting
7235
$specials{heredoc}=1;
7236
7237
# reply token
7238
return('Heredoc_close', [$1, $lineNrs{$inHandle}]);
7239
}
7240
7241
# can we take the rest of the line at *once*?
7242
if (($parserState==STATE_COMMENT or $parserState==STATE_VERBATIM) and $parser->{USER}->{INPUT} ne "\n")
7243
{
7244
# grab line and chomp if necessary
7245
my $line=$parser->{USER}->{INPUT};
7246
chomp($line) unless $parserState==STATE_VERBATIM;
7247
7248
# update input line (restore trailing newline if it will be used to detect paragraph completion)
7249
$parser->{USER}->{INPUT}=$parserState==STATE_VERBATIM ? '' : "\n";
7250
7251
# trace, if necessary
7252
warn qq([Trace] Lexer: word "$line" in line $lineNrs{$inHandle}.\n) if $flags{trace} & TRACE_LEXER;
7253
7254
# supply result
7255
return('Word', [$line, $lineNrs{$inHandle}]);
7256
}
7257
7258
# reply a token
7259
for ($parser->{USER}->{INPUT})
7260
{
7261
# declare scopies
7262
my ($found, $sfound);
7263
7264
# check for table separators, if necessary (these are the most common strings)
7265
if (@tableSeparatorStack)
7266
{
7267
# check for a column separator
7268
s/^$tableSeparatorStack[0][0]//,
7269
(($flags{trace} & TRACE_LEXER) and warn("[Trace] Lexer: table column separator in line $lineNrs{$inHandle}.\n")),
7270
return('Table_separator', ['c', $lineNrs{$inHandle}]) if /^($tableSeparatorStack[0][0])/;
7271
7272
# check for row separator
7273
s/^$tableSeparatorStack[0][1]//,
7274
(($flags{trace} & TRACE_LEXER) and warn("[Trace] Lexer: table row separator in line $lineNrs{$inHandle}.\n")),
7275
return('Table_separator', ['r', $lineNrs{$inHandle}]) if /^($tableSeparatorStack[0][1])/;
7276
}
7277
7278
# reply next token: EOL?
7279
if (/^(\n)/)
7280
{
7281
if ($lexerFlags{eol}==LEXER_TOKEN)
7282
{
7283
$found=$1;
7284
warn("[Trace] Lexer: EOL in line $lineNrs{$inHandle}.\n") if $flags{trace} & TRACE_LEXER;
7285
s/^$1//;
7286
return('EOL', [$found, $lineNrs{$inHandle}]);
7287
}
7288
elsif ($lexerFlags{eol}==LEXER_EMPTYLINE)
7289
{
7290
# flag "empty line" as wished
7291
warn("[Trace] Lexer: EOL -> Empty_line in line $lineNrs{$inHandle}.\n") if $flags{trace} & TRACE_LEXER;
7292
s/^$1//;
7293
return('Empty_line', ['', $lineNrs{$inHandle}]);
7294
}
7295
elsif ($lexerFlags{eol}==LEXER_SPACE)
7296
{
7297
# flag "space" as wished and reply a simple whitespace
7298
warn("[Trace] Lexer: EOL -> Space in line $lineNrs{$inHandle}.\n") if $flags{trace} & TRACE_LEXER;
7299
s/^$1//;
7300
return('Space', [' ', $lineNrs{$inHandle}]);
7301
}
7302
else
7303
{die "[BUG] Unhandled EOL directive $lexerFlags{eol}.";}
7304
}
7305
7306
# reply next token: scan for Ils if necessary
7307
$found=$1, s/^$1//,
7308
(($flags{trace} & TRACE_LEXER) and warn("[Trace] Lexer: Ils in line $lineNrs{$inHandle}.\n")),
7309
return('Ils', [$found, $lineNrs{$inHandle}]) if $parserState==STATE_PFILTERED and /^$lexerPatterns{space}/;
7310
7311
# reply next token: scan for spaces
7312
$found=$1, s/^$1//,
7313
(($flags{trace} & TRACE_LEXER) and warn("[Trace] Lexer: Space in line $lineNrs{$inHandle}.\n")),
7314
return('Space', [$found, $lineNrs{$inHandle}]) if /^$lexerPatterns{space}/;
7315
7316
# reply next token: scan for paragraph filter delimiters ("||" and "|")
7317
$found=$1, s/^\Q$1//,
7318
(($flags{trace} & TRACE_LEXER) and warn(qq([Trace] Lexer: Paragraph filter delimiter "$found" in line $lineNrs{$inHandle}.\n))),
7319
return($found, [$found, $lineNrs{$inHandle}]) if /^$lexerPatterns{pfilterDelimiter}/ and $specials{pfilter};
7320
7321
# reply next token: scan for here doc openers
7322
$found=$1, s/^<<$1//,
7323
(($flags{trace} & TRACE_LEXER) and warn("[Trace] Lexer: Heredoc opener $found in line $lineNrs{$inHandle}.\n")),
7324
return('Heredoc_open', [$found, $lineNrs{$inHandle}]) if /^<<(\w+)/ and $specials{heredoc} eq '1';
7325
7326
# reply next token: scan for SPECIAL tagnames: \TABLE
7327
$found=$1, s/^\\$1//,
7328
(($flags{trace} & TRACE_LEXER) and warn("[Trace] Lexer: Table starts in line $lineNrs{$inHandle}.\n")),
7329
return('Table', [$found, $lineNrs{$inHandle}]) if $specials{tag} and /^$lexerPatterns{table}/;
7330
7331
# reply next token: scan for SPECIAL tagnames: \END_TABLE
7332
$found=$1, s/^\\$1//,
7333
(($flags{trace} & TRACE_LEXER) and warn("[Trace] Lexer: Table completed in line $lineNrs{$inHandle}.\n")),
7334
return('Tabled', [$found, $lineNrs{$inHandle}]) if $specials{tag} and /^$lexerPatterns{endTable}/;
7335
7336
# reply next token: scan for SPECIAL tagnames: \EMBED
7337
$found=$1, s/^\\$1//,
7338
(($flags{trace} & TRACE_LEXER) and warn("[Trace] Lexer: Embedding starts in line $lineNrs{$inHandle}.\n")),
7339
return('Embed', [$found, $lineNrs{$inHandle}]) if $specials{tag} and /^$lexerPatterns{embed}/;
7340
7341
# reply next token: scan for SPECIAL tagnames: \END_EMBED
7342
$found=$1, s/^\\$1//,
7343
(($flags{trace} & TRACE_LEXER) and warn("[Trace] Lexer: Embedding completed in line $lineNrs{$inHandle}.\n")),
7344
return('Embedded', [$found, $lineNrs{$inHandle}]) if $specials{embedded} and /^$lexerPatterns{endEmbed}/;
7345
7346
# reply next token: scan for SPECIAL tagnames: \INCLUDE
7347
$found=$1, s/^\\$1//,
7348
(($flags{trace} & TRACE_LEXER) and warn("[Trace] Lexer: Including starts in line $lineNrs{$inHandle}.\n")),
7349
return('Include', [$found, $lineNrs{$inHandle}]) if $specials{tag} and /^$lexerPatterns{include}/;
7350
7351
# reply next token: scan for tagnames
7352
$found=$1, s/^\\$1//,
7353
(($flags{trace} & TRACE_LEXER) and warn("[Trace] Lexer: Tag opener $found in line $lineNrs{$inHandle}.\n")),
7354
return('Tag_name', [$found, $lineNrs{$inHandle}]) if $specials{tag} and /^$lexerPatterns{tag}/ and (exists $tagsRef->{$1} or exists $macros{$1});
7355
7356
# reply next token: scan for special characters
7357
$found=$1, s/^\Q$1//,
7358
(($flags{trace} & TRACE_LEXER) and warn("[Trace] Lexer: Special $found in line $lineNrs{$inHandle}.\n")),
7359
return($found, [$found, $lineNrs{$inHandle}]) if /^$patternNlbBackslash(\S)/ and exists $specials{$1} and $specials{$1};
7360
7361
# reply next token: scan for definition list items
7362
$found=$1, s/^$1//,
7363
(($flags{trace} & TRACE_LEXER) and warn("[Trace] Lexer: Colon in line $lineNrs{$inHandle}.\n")),
7364
return('Colon', [$found, $lineNrs{$inHandle}]) if $specials{colon} and /^$lexerPatterns{colon}/;
7365
7366
# reply next token: search for named variables (which need to be defined except at the
7367
# beginning of a new assignment paragraph)
7368
$found=$1, s/^\$$1//,
7369
(($flags{trace} & TRACE_LEXER) and warn(qq([Trace] Lexer: Named variable "$found" in line $lineNrs{$inHandle}.\n))),
7370
return('Named_variable', [$found, $lineNrs{$inHandle}])
7371
if /^$lexerPatterns{namedVar}(=?)/
7372
and (
7373
($parserState==STATE_DEFAULT and defined($2))
7374
or exists $variables{$1}
7375
);
7376
7377
# reply next token: search for symbolic variables (these cannot be used in assignments,
7378
# so handling is easier)
7379
$found=$2, s/^\$$1//,
7380
(($flags{trace} & TRACE_LEXER) and warn(qq([Trace] Lexer: Symbolic variable "$found" in line $lineNrs{$inHandle}.\n))),
7381
return('Symbolic_variable', [$found, $lineNrs{$inHandle}])
7382
if /^$lexerPatterns{symVar}/ and exists $variables{$2};
7383
7384
# flag that this paragraph *might* use macros someday, if there is still something being no tag and no
7385
# macro, but looking like a tag or a macro (somebody could *later* declare it a real macro, so the cache
7386
# needs to check macro definitions)
7387
$flags{checksummed}[3]=1
7388
if $specials{tag} and /^$lexerPatterns{tag}/
7389
and not (exists $flags{checksummed} and not $flags{checksummed});
7390
7391
# likewise, flag that this paragraph *might* use variables someday, if there is still something being no variable,
7392
# but looking like a variable (somebody could *later* declare it a real var, so the cache
7393
# needs to check variable definitions)
7394
$flags{checksummed}[4]=1
7395
if /($lexerPatterns{namedVarKernel})|($lexerPatterns{symVarKernel})/
7396
and not (exists $flags{checksummed} and not $flags{checksummed});
7397
7398
# remove guarding \\, if necessary
7399
s/^\\// unless $specials{heredoc}
7400
or (defined $lexerFlags{backsl} and $lexerFlags{backsl}==LEXER_TOKEN)
7401
or $parserState==STATE_EMBEDDING
7402
or $parserState==STATE_PFILTER
7403
or $parserState==STATE_CONDITION
7404
or $parserState==STATE_DEFINITION;
7405
7406
# reply next token: scan for numbers, if necessary
7407
$found=$1, s/^$1//,
7408
(($flags{trace} & TRACE_LEXER) and warn("[Trace] Lexer: Number $found in line $lineNrs{$inHandle}.\n")),
7409
return('Number', [$found, $lineNrs{$inHandle}]) if $specials{number} and /^(\d+)/;
7410
7411
unless ($flags{noboost})
7412
{
7413
# build set of characters to be special
7414
my $special=join('', '([', (map {exists $specials2patterns{$_} ? $specials2patterns{$_} : $_} grep(($specials{$_} and (length==1 or exists $specials2patterns{$_})), keys %specials)), '\n\\\\', '])');
7415
$special=qr($special|(\|{1,2})) if $specials{pfilter};
7416
$special=qr($special|($tableSeparatorStack[0][0])|($tableSeparatorStack[0][1])) if @tableSeparatorStack;
7417
$special=qr($special|(($lexerPatterns{namedVar})|($lexerPatterns{symVar})));
7418
7419
# reply next token: scan for word or single character (declared as "Word" as well)
7420
#warn("~~~~~~~~~> $special\n");
7421
#warn("---------> $_");
7422
$found=$1, s/^\Q$1//,
7423
#warn("=====> $found\n\n"),
7424
(($flags{trace} & TRACE_LEXER) and warn(qq([Trace] Lexer: (Boosted) word "$found" in line $lineNrs{$inHandle}.\n))),
7425
return('Word', [$found, $lineNrs{$inHandle}])
7426
if $_!~/^$special/ and /^(.+?)($special|($))/;
7427
}
7428
7429
# reply next token: scan for word or single character (declared as "Word" as well)
7430
$found=$1, s/^\Q$1//,
7431
(($flags{trace} & TRACE_LEXER) and warn(qq([Trace] Lexer: Word "$found" in line $lineNrs{$inHandle}.\n))),
7432
return('Word', [$found, $lineNrs{$inHandle}]) if /^($patternWUmlauts)/ or /^(\S)/;
7433
7434
# everything should be handled - this code should never be executed!
7435
die qq([BUG] $sourceFile, line $lineNrs{$inHandle}: No symbol found in "$_"!\n);
7436
}
7437
}
7438
7439
7440
# evaluate a tag condition (can possibly be generalized: this is just a piece of code)
7441
sub _evalTagCondition
7442
{
7443
# get parameters
7444
my ($code, $file, $line)=@_;
7445
confess "[BUG] Missing code parameter.\n" unless defined $code;
7446
confess "[BUG] Missing file parameter.\n" unless defined $file;
7447
confess "[BUG] Missing line parameter.\n" unless defined $line;
7448
7449
# declare variables
7450
my ($rc);
7451
7452
# Does the caller want to evaluate the code?
7453
if ($safeObject)
7454
{
7455
# update active contents base data, if necessary
7456
if ($flags{activeBaseData})
7457
{
7458
no strict 'refs';
7459
${join('::', ref($safeObject) ? $safeObject->root : 'main', 'PerlPoint')}=dclone($flags{activeBaseData});
7460
}
7461
7462
# make the code a string and evaluate it
7463
warn "[Trace] $sourceFile, line $line: Evaluating this code:\n\n$code\n\n\n" if $flags{trace} & TRACE_ACTIVE;
7464
7465
# invoke perl to compute the result
7466
$rc=ref($safeObject) ? $safeObject->reval($code) : eval(join(' ', '{package main; no strict;', $code, '}'));
7467
7468
# check result
7469
_semerr($_[0], "$file, line $line: tag condition could not be evaluated: $@.") if $@;
7470
}
7471
7472
# supply result
7473
$rc;
7474
}
7475
7476
# reference lexed: reply appropriate token
7477
sub _refLexed
7478
{
7479
# get parameters
7480
my ($parser)=@_;
7481
7482
# we got an already prepared stream part or a delayed token
7483
if (ref($parser->{USER}->{INPUT}) eq 'PerlPoint::Parser::DelayedToken')
7484
{
7485
my $delayedToken=$parser->{USER}->{INPUT};
7486
$parser->{USER}->{INPUT}='';
7487
return($delayedToken->token, $delayedToken->value);
7488
}
7489
else
7490
{
7491
my $streamedPart=$parser->{USER}->{INPUT};
7492
$parser->{USER}->{INPUT}='';
7493
return('StreamedPart', [$streamedPart, $lineNrs{$inHandle}]);
7494
}
7495
}
7496
7497
7498
sub _lineStartResearch
7499
{
7500
# get parameters
7501
my ($parser)=@_;
7502
7503
# scan for indented lines, if necessary
7504
if ($parser->{USER}->{INPUT}=~/^(\s+)/)
7505
{
7506
if ($lexerFlags{ils}==LEXER_TOKEN)
7507
{
7508
# trace, if necessary
7509
warn "[Trace] Lexer: Ils in line $lineNrs{$inHandle}.\n" if $flags{trace} & TRACE_LEXER;
7510
7511
# update input buffer and reply the token (contents is necessary as well)
7512
my $ils=$1;
7513
$parser->{USER}->{INPUT}=~s/^$1//;
7514
return(1, 'Ils', [$ils, $lineNrs{$inHandle}]);
7515
}
7516
elsif ($lexerFlags{ils}==LEXER_IGNORE)
7517
{
7518
warn "[Trace] Lexer: Ils in line $lineNrs{$inHandle} is ignored.\n" if $flags{trace} & TRACE_LEXER;
7519
$parser->{USER}->{INPUT}=~s/^(\s+)//;
7520
}
7521
}
7522
7523
# scan for a need of a virtual token opening a new paragraph
7524
# (to avoid parser state trouble caused by filters when the parser needs a lookahead
7525
# to detect the next paragraph)
7526
# warn "------> state $parserState (", STATE_DEFAULT, "), flag $flags{virtualParagraphStart}, $lexerFlagsOfPreviousState{cbell}\n";
7527
if ($parserState==STATE_DEFAULT and $flags{virtualParagraphStart} and $lexerFlagsOfPreviousState{cbell} ne LEXER_IGNORE)
7528
{
7529
warn "[Trace] Inserted virtual token to enable clean parser lookahead after pfilter invokation.\n" if $flags{trace} & TRACE_LEXER;
7530
return(1, 'Word', ['', $lineNrs{$inHandle}])
7531
if $lexerFlagsOfPreviousState{cbell} eq 'Ils'
7532
or $parser->{USER}->{INPUT}!~/^$lexerFlagsOfPreviousState{cbell}/;
7533
}
7534
7535
# scan for a new paragraph opened by a tag, if necessary
7536
if (($parserState==STATE_DEFAULT or $parserState==STATE_PFILTERED) and $parser->{USER}->{INPUT}=~/^\\/)
7537
{
7538
# remain in default state, but switch to its tag mode
7539
_stateManager(STATE_DEFAULT_TAGMODE);
7540
}
7541
7542
# flag that there is no token to return
7543
0;
7544
}
7545
7546
# ----------------------------------------------------------------------------------------------
7547
# Internal function: error message display.
7548
# ----------------------------------------------------------------------------------------------
7549
sub _Error
7550
{
7551
# get parameters
7552
my ($parser)=@_;
7553
7554
# declare base indention
7555
my $baseIndentation=' ' x length('[Error] ');
7556
7557
# use $_[0]->YYCurtok to display the recognized *token* if necessary
7558
# - for users convenience, it is suppressed in the message
7559
warn "\n\n[Error] $sourceFile, ",
7560
${$parser->YYCurval}[1] > 0 ? "line ${$parser->YYCurval}[1]" : 'all sources read',
7561
(exists $statistics{cache} and $statistics{cache}[1]) ? ' (or below because of cache hits)'
7562
: (),
7563
': found ',
7564
defined ${$parser->YYCurval}[0] ? qq("${$parser->YYCurval}[0]") : 'nothing',
7565
", expected:\n$baseIndentation",
7566
' ' x length('or '),
7567
join("\n${baseIndentation}or ",
7568
map {
7569
exists $tokenDescriptions{$_} ? defined $tokenDescriptions{$_} ? $tokenDescriptions{$_}
7570
: ()
7571
: $_
7572
} sort grep($_!~/cache_hit$/, $parser->YYExpect)
7573
),
7574
".\n\n";
7575
7576
# visualize error position
7577
warn(
7578
(map {my $l=$_->[1]; chomp($l); "$baseIndentation$l\n"} reverse @inLine==1 ? @inLine : @inLine[0, -1]), "",
7579
$baseIndentation, ' ' x ($inLine[0][0]-length($parser->{USER}->{INPUT})-1), "^\n",
7580
$baseIndentation, '_' x ($inLine[0][0]-length($parser->{USER}->{INPUT})-1), '|', "\n\n\n"
7581
) if @inLine;
7582
}
7583
7584
# ----------------------------------------------------------------------------------------------
7585
# Internal function: state manager.
7586
# ----------------------------------------------------------------------------------------------
7587
sub _stateManager
7588
{
7589
# get parameter
7590
my ($newState)=@_;
7591
7592
# check parameter
7593
confess "[BUG] Invalid new state $newState passed.\n" unless $newState==STATE_DEFAULT
7594
or $newState==STATE_DEFAULT_TAGMODE
7595
or $newState==STATE_TEXT
7596
or $newState==STATE_UPOINT
7597
or $newState==STATE_OPOINT
7598
or $newState==STATE_DPOINT
7599
or $newState==STATE_DPOINT_ITEM
7600
or $newState==STATE_BLOCK
7601
or $newState==STATE_VERBATIM
7602
or $newState==STATE_EMBEDDING
7603
or $newState==STATE_PFILTER
7604
or $newState==STATE_PFILTERED
7605
or $newState==STATE_CONDITION
7606
or $newState==STATE_HEADLINE_LEVEL
7607
or $newState==STATE_HEADLINE
7608
or $newState==STATE_TABLE
7609
or $newState==STATE_DEFINITION
7610
or $newState==STATE_CONTROL
7611
or $newState==STATE_COMMENT;
7612
7613
# store the new state
7614
$parserState=$newState;
7615
7616
# enter new state: default
7617
$newState==STATE_DEFAULT and do
7618
{
7619
# buffer last states lexer flags (take care of a clean init)
7620
%lexerFlagsOfPreviousState=%lexerFlags ? %lexerFlags : (cbell => LEXER_IGNORE);
7621
7622
# prepare lexer
7623
@lexerFlags{qw(ils eol el cbell)}=(LEXER_TOKEN, LEXER_EMPTYLINE, LEXER_IGNORE, LEXER_IGNORE);
7624
7625
# activate special characters as necessary
7626
@specials{('.', '/', '*', '#', '=', '<', '>', '{', '}' , '-', '?', '@', '+', '~', 'heredoc', 'colon', 'tag', 'embedded', 'number', 'pfilter')}=(1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1);
7627
7628
# trace, if necessary
7629
warn "[Trace] Entered default state.\n" if $flags{trace} & TRACE_SEMANTIC;
7630
7631
# well done
7632
return;
7633
};
7634
7635
# enter new state: paragraph filter installation
7636
$newState==STATE_PFILTER and do
7637
{
7638
# prepare lexer
7639
@lexerFlags{qw(ils eol el cbell)}=(LEXER_TOKEN, LEXER_EMPTYLINE, LEXER_IGNORE, LEXER_IGNORE);
7640
7641
# activate special characters as necessary
7642
@specials{('.', '/', '*', '#', '=', '<', '>', '{', '}' , '-', '?', '@', '+', '~', 'heredoc', 'colon', 'tag', 'embedded', 'number', 'pfilter')}=(1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 0, 1, 1, 1, 0, 0, 1);
7643
7644
# trace, if necessary
7645
warn "[Trace] Entered pfilter installation state.\n" if $flags{trace} & TRACE_SEMANTIC;
7646
7647
# well done
7648
return;
7649
};
7650
7651
# enter new state: paragraph filter (similar to default except for the name)
7652
$newState==STATE_PFILTERED and do
7653
{
7654
# prepare lexer
7655
@lexerFlags{qw(ils eol el cbell)}=(LEXER_TOKEN, LEXER_EMPTYLINE, LEXER_IGNORE, LEXER_IGNORE);
7656
7657
# activate special characters as necessary
7658
@specials{('.', '/', '*', '#', '=', '<', '>', '{', '}' , '-', '?', '@', '+', '~', 'heredoc', 'colon', 'tag', 'embedded', 'number', 'pfilter')}=(1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 0, 1, 1, 1, 0, 0, 1);
7659
7660
# trace, if necessary
7661
warn "[Trace] Entered postfilter default state.\n" if $flags{trace} & TRACE_SEMANTIC;
7662
7663
# well done
7664
return;
7665
};
7666
7667
7668
# enter new state: default in tag mode (same as default, but a paragraph starting with a tag delays switching to other
7669
# modes, so we have to explicitly disable the paragraph opener specials)
7670
$newState==STATE_DEFAULT_TAGMODE and do
7671
{
7672
# prepare lexer
7673
@lexerFlags{qw(ils eol el cbell)}=(LEXER_TOKEN, LEXER_EMPTYLINE, LEXER_IGNORE, LEXER_IGNORE);
7674
7675
# activate special characters as necessary
7676
@specials{('.', '/', '*', '#', '=', '<', '>', '{', '}' , '-', '?', '@', '+', '~', 'heredoc', 'colon', 'tag', 'embedded', 'number', 'pfilter')}=(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0);
7677
7678
# trace, if necessary
7679
warn "[Trace] Entered default state in tag mode.\n" if $flags{trace} & TRACE_SEMANTIC;
7680
7681
# well done
7682
return;
7683
};
7684
7685
# enter new state: headline body
7686
($newState==STATE_HEADLINE or $newState==STATE_HEADLINE_LEVEL) and do
7687
{
7688
# prepare lexer
7689
@lexerFlags{qw(ils eol el cbell)}=(LEXER_IGNORE, LEXER_SPACE, LEXER_TOKEN, LEXER_IGNORE);
7690
7691
# activate special characters as necessary
7692
@specials{('.', '/', '*', '#', '=', '<', '>', '{', '}' , '-', '?', '@', '+', '~', 'heredoc', 'colon', 'tag', 'embedded', 'number', 'pfilter')}=(0, 0, 0, 0, $newState==STATE_HEADLINE ? 0 : 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0);
7693
7694
# trace, if necessary
7695
warn "[Trace] Entered headline ", $newState==STATE_HEADLINE ? 'body' : 'level', " state.\n" if $flags{trace} & TRACE_SEMANTIC;
7696
7697
# well done
7698
return;
7699
};
7700
7701
# enter new state: comment
7702
$newState==STATE_COMMENT and do
7703
{
7704
# prepare lexer
7705
@lexerFlags{qw(ils eol el cbell)}=(LEXER_IGNORE, LEXER_EMPTYLINE, LEXER_IGNORE, LEXER_IGNORE);
7706
7707
# activate special characters as necessary
7708
@specials{('.', '/', '*', '#', '=', '<', '>', '{', '}' , '-', '?', '@', '+', '~', 'heredoc', 'colon', 'tag', 'embedded', 'number', 'pfilter')}=(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
7709
7710
# trace, if necessary
7711
warn "[Trace] Entered comment state.\n" if $flags{trace} & TRACE_SEMANTIC;
7712
7713
# well done
7714
return;
7715
};
7716
7717
# enter new state: text
7718
$newState==STATE_TEXT and do
7719
{
7720
# prepare lexer
7721
@lexerFlags{qw(ils eol el cbell)}=(LEXER_IGNORE, LEXER_SPACE, LEXER_TOKEN, LEXER_IGNORE);
7722
7723
# activate special characters as necessary
7724
@specials{('.', '/', '*', '#', '=', '<', '>', '{', '}' , '-', '?', '@', '+', '~', 'heredoc', 'colon', 'tag', 'embedded', 'number', 'pfilter')}=(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0);
7725
7726
# trace, if necessary
7727
warn "[Trace] Entered text state.\n" if $flags{trace} & TRACE_SEMANTIC;
7728
7729
# well done
7730
return;
7731
};
7732
7733
# enter new state: text
7734
$newState==STATE_TABLE and do
7735
{
7736
# prepare lexer
7737
@lexerFlags{qw(ils eol el cbell)}=(LEXER_SPACE, LEXER_TOKEN, LEXER_TOKEN, LEXER_IGNORE);
7738
7739
# activate special characters as necessary
7740
@specials{('.', '/', '*', '#', '=', '<', '>', '{', '}' , '-', '?', '@', '+', '~', 'heredoc', 'colon', 'tag', 'embedded', 'number', 'pfilter')}=(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0);
7741
7742
# trace, if necessary
7743
warn "[Trace] Entered table paragraph state.\n" if $flags{trace} & TRACE_SEMANTIC;
7744
7745
# well done
7746
return;
7747
};
7748
7749
# enter new state: text
7750
$newState==STATE_DEFINITION and do
7751
{
7752
# prepare lexer
7753
@lexerFlags{qw(ils eol el cbell)}=(LEXER_IGNORE, LEXER_SPACE, LEXER_TOKEN, LEXER_IGNORE);
7754
7755
# activate special characters as necessary
7756
@specials{('.', '/', '*', '#', '=', '<', '>', '{', '}' , '-', '?', '@', '+', '~', 'heredoc', 'colon', 'tag', 'embedded', 'number', 'pfilter')}=(0, 0, 0, 0, 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0);
7757
7758
# trace, if necessary
7759
warn "[Trace] Entered macro definition state.\n" if $flags{trace} & TRACE_SEMANTIC;
7760
7761
# well done
7762
return;
7763
};
7764
7765
# enter new state: unordered list point - defined item
7766
($newState==STATE_DPOINT_ITEM) and do
7767
{
7768
# prepare lexer
7769
@lexerFlags{qw(ils eol el cbell)}=(LEXER_IGNORE, LEXER_SPACE, LEXER_TOKEN, LEXER_TOKEN);
7770
7771
# activate special characters as necessary
7772
@specials{('.', '/', '*', '#', '=', '<', '>', '{', '}' , '-', '?', '@', '+', '~', 'heredoc', 'colon', 'tag', 'embedded', 'number', 'pfilter')}=(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0);
7773
7774
# trace, if necessary
7775
warn "[Trace] Entered definition item state.\n" if $flags{trace} & TRACE_SEMANTIC;
7776
7777
# well done
7778
return;
7779
};
7780
7781
# enter new state: list point
7782
($newState==STATE_UPOINT or $newState==STATE_OPOINT or $newState==STATE_DPOINT) and do
7783
{
7784
# prepare lexer
7785
@lexerFlags{qw(ils eol el cbell)}=(LEXER_IGNORE, LEXER_SPACE, LEXER_TOKEN, qr([*#:]));
7786
7787
# activate special characters as necessary
7788
@specials{('.', '/', '*', '#', '=', '<', '>', '{', '}' , '-', '?', '@', '+', '~', 'heredoc', 'colon', 'tag', 'embedded', 'number', 'pfilter')}=(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0);
7789
7790
# trace, if necessary
7791
warn "[Trace] Entered point state.\n" if $flags{trace} & TRACE_SEMANTIC;
7792
7793
# well done
7794
return;
7795
};
7796
7797
# enter new state: block
7798
$newState==STATE_BLOCK and do
7799
{
7800
# prepare lexer
7801
@lexerFlags{qw(ils eol el cbell)}=(LEXER_SPACE, LEXER_TOKEN, LEXER_TOKEN, 'Ils');
7802
7803
# activate special characters as necessary
7804
@specials{('.', '/', '*', '#', '=', '<', '>', '{', '}' , '-', '?', '@', '+', '~', 'heredoc', 'colon', 'tag', 'embedded', 'number', 'pfilter')}=(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0);
7805
7806
# trace, if necessary
7807
warn "[Trace] Entered block state.\n" if $flags{trace} & TRACE_SEMANTIC;
7808
7809
# well done
7810
return;
7811
};
7812
7813
# enter new state: verbatim block
7814
$newState==STATE_VERBATIM and do
7815
{
7816
# prepare lexer
7817
@lexerFlags{qw(ils eol el cbell)}=(LEXER_SPACE, LEXER_TOKEN, LEXER_TOKEN, LEXER_IGNORE);
7818
7819
# activate special characters as necessary
7820
@specials{('.', '/', '*', '#', '=', '<', '>', '{', '}' , '-', '?', '@', '+', '~', 'heredoc', 'colon', 'tag', 'embedded', 'number', 'pfilter')}=(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0);
7821
7822
# trace, if necessary
7823
warn "[Trace] Entered verbatim state.\n" if $flags{trace} & TRACE_SEMANTIC;
7824
7825
# well done
7826
return;
7827
};
7828
7829
# enter new state: embedding
7830
$newState==STATE_EMBEDDING and do
7831
{
7832
# prepare lexer
7833
@lexerFlags{qw(ils eol el cbell)}=(LEXER_SPACE, LEXER_TOKEN, LEXER_TOKEN, LEXER_IGNORE);
7834
7835
# activate special characters as necessary
7836
@specials{('.', '/', '*', '#', '=', '<', '>', '{', '}' , '-', '?', '@', '+', '~', 'heredoc', 'colon', 'tag', 'embedded', 'number', 'pfilter')}=(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0);
7837
7838
# trace, if necessary
7839
warn "[Trace] Entered embedding state.\n" if $flags{trace} & TRACE_SEMANTIC;
7840
7841
# well done
7842
return;
7843
};
7844
7845
# enter new state: condition (very similar to embedding, naturally)
7846
$newState==STATE_CONDITION and do
7847
{
7848
# prepare lexer
7849
@lexerFlags{qw(ils eol el cbell)}=(LEXER_SPACE, LEXER_SPACE, LEXER_TOKEN, LEXER_IGNORE);
7850
7851
# activate special characters as necessary
7852
@specials{('.', '/', '*', '#', '=', '<', '>', '{', '}' , '-', '?', '@', '+', '~', 'heredoc', 'colon', 'tag', 'embedded', 'number', 'pfilter')}=(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
7853
7854
# trace, if necessary
7855
warn "[Trace] Entered condition state.\n" if $flags{trace} & TRACE_SEMANTIC;
7856
7857
# well done
7858
return;
7859
};
7860
7861
# enter new state: unordered list point
7862
$newState==STATE_CONTROL and do
7863
{
7864
# prepare lexer
7865
@lexerFlags{qw(ils eol el cbell)}=(LEXER_IGNORE, LEXER_IGNORE, LEXER_TOKEN, LEXER_IGNORE);
7866
7867
# activate special characters as necessary
7868
@specials{('.', '/', '*', '#', '=', '<', '>', '{', '}' , '-', '?', '@', '+', '~', 'heredoc', 'colon', 'tag', 'embedded', 'number', 'pfilter')}=(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
7869
7870
# trace, if necessary
7871
warn "[Trace] Entered control state.\n" if $flags{trace} & TRACE_SEMANTIC;
7872
7873
# well done
7874
return;
7875
};
7876
7877
# check yourself
7878
confess "[BUG] Unhandled state $newState.\n";
7879
}
7880
7881
7882
=pod
7883
7884
=head2 run()
7885
7886
This function starts the parser to process a number of specified files.
7887
7888
B
7889
All parameters except of the I parameter are named (pass them by hash).
7890
7891
=over 4
7892
7893
=item activeBaseData
7894
7895
This optional parameter allows to pass common data to all active contents
7896
(conditions, embedded and included Perl) by a I. By convention,
7897
a translator at least passes the target language and user settings by
7898
7899
activeBaseData => {
7900
targetLanguage => "lang",
7901
userSettings => \%userSettings,
7902
},
7903
7904
User settings are intended to allow the specification of per call settings by a
7905
user, e.g. to include special parts. By using this convention, users can easily
7906
specify such a part the following way
7907
7908
? flagSet('setting')
7909
7910
Special part.
7911
7912
? 1
7913
7914
It is up to a translator author to declare translator specific settings (and to
7915
document them). The passed values can be as complex as necessary as long as they
7916
can be duplicated by C.
7917
7918
Whenever active contents is invoked, the passed hash reference is copied
7919
(duplicated by C) into the Safe objects namespace
7920
(see I) as a global variable $PerlPoint. This way, modifications by
7921
invoked code do not effect subsequently called code snippets, base data are
7922
always fresh.
7923
7924
=item activeDataInit
7925
7926
Reserved to pass hook functions to be called preparing every active contents
7927
invokation. I
7928
7929
=item cache
7930
7931
This optional parameter controls source file paragraph caching.
7932
7933
By default, a source file is parsed completely everytime you pass it to the
7934
parser. This is no problem with tiny sources but can delay your work if you
7935
are dealing with large sources which have to be translated periodically into
7936
presentations while they are written. Typically most of the paragraphs remain
7937
unchanged from version to version, but nevertheless everything is usually
7938
reparsed which means a waste of time. Well, to improve this a paragraph
7939
cache can be activated by setting this option to B.
7940
7941
The parser caches each I individually. That means
7942
if three files are passed to the parser with activated caching, three cache
7943
files will be written. They are placed in the source file directory, named
7944
..ppcache. Please note that the paragraphs of I sources
7945
are cached in the cache file of the I document because they may have to
7946
be evaluated differently depending on inclusion context.
7947
7948
What acceleration can be expected? Well, this I
7949
depends on your source structure. Efficiency will grow with longer paragraphs,
7950
reused paragraphs and paragraph number. It will be reduced by heavy usage
7951
of active contents and embedding because every paragraph that refers
7952
to parts defined externally is not strongly determined by itself and therefore
7953
it cannot be cached. Here is a list of all reasons which cause a paragraph to
7954
be excluded from caching:
7955
7956
=over 4
7957
7958
=item Embedded parts
7959
7960
Obviously dynamic parts may change from one version to another, but even static
7961
parts could have to be interpreted differently because a user can set up new
7962
Is.
7963
7964
=item Included files
7965
7966
An \INCLUDE tag immediately disables caching for the paragraph it resides in
7967
because the loaded file may change its contents. This is not really a
7968
restriction because the included paragraphs themselves I cached if possible.
7969
7970
=item Filtered paragraphs
7971
7972
A paragraph filter can transform a source paragraph in whatever the author of
7973
a Perl function might think is useful, potentially depending on highly dynamical
7974
data. So it cannot be determined by the parser what the final translation of a
7975
certain source paragraph will be.
7976
7977
=item Document stream entry points
7978
7979
Depending on the parsers configuration, these points can be transformed into
7980
headlines or remain unchanged, so there is no fixed up mapping between a
7981
source paragraph and its streamed expression.
7982
7983
=back
7984
7985
Even with these restrictions about 70% of a real life document of more than
7986
150 paragraphs could be cached. This saved more than 60% of parsing time in
7987
subsequent translator calls.
7988
7989
New cache entries are always I which means that old entries are never
7990
replaced and a cache file tends to grow. If you ever wish to clean up a
7991
cache file completely pass B to this option.
7992
7993
To deactivate caching explicitly pass B.
7994
I
7995
7996
Settings can be combined by I.
7997
7998
# clean up the cache, then refill it
7999
cache => CACHE_CLEANUP+CACHE_ON,
8000
8001
# clean up the cache and deactivate it
8002
cache => CACHE_CLEANUP+CACHE_OFF,
8003
8004
The B value is overwritten by any other setting.
8005
8006
It is suggested to make this setting available to translator users to let
8007
them decide if a cache should be used.
8008
8009
I that there is a problem with line numbers if paragraphs are
8010
restored from cache because of the behaviour of perls paragraph mode. In this
8011
mode, the <> operator reads in any number of newlines between paragraphs but
8012
supplies only one of them. That is why I do not get the real number of lines
8013
in a paragraph and therefore cannot store them. To work around this, two
8014
strategies can be used. First, do not use more than exactly one newline
8015
between paragraphs. (This strategy is not for real life users, of course,
8016
but in this case restored numbers would be correct.) Second, remember that
8017
source line numbers are only interesting in error messages. If the parser
8018
detects an error, it therefore says: error "there or later" when a cache hit
8019
already occured. If the real number is wished the parser could be reinvoked
8020
then with deactivated cache and will report it.
8021
8022
I occurs if you parse on a UNIX
8023
system but your document (or parts of it) were written in DOS format. The
8024
paragraph mode reads such a document I. Please replace the line
8025
ending character sequences system appropriate. (If you are using C
8026
under Solaris please invoke it with option C<-ascii> to do this.)
8027
8028
More, Perls paragraph mode and PerlPoint treat whitespace lines differently.
8029
Because of the way it works, paragraph mode does not recognize them as "empty"
8030
while PerlPoint I for reasons of usability (invisible characters should
8031
not make a difference). This means that lines containing only whitespaces
8032
separate PerlPoint paragraphs but not "Perl" paragraphs, making the cache
8033
working wrong especially in examples. If paragraphs unintentionally disappear
8034
in the resulting presentation, please check the "empty lines" before them.
8035
8036
Consistent cache data depend on the versions of the parser, of constant
8037
declarations and of the module B which is used internally. If the
8038
parser detects a significant change in one of these versions, existing
8039
caches are automatically rebuilt.
8040
8041
I cache files are not locked while they are used.
8042
If you need this feature please let me know.
8043
8044
=item criticalSemanticErrors
8045
8046
If set to a true value, semantic errors will cause the parser to terminate
8047
immediately. This defaults to false: errors are accumulated and finally
8048
reported.
8049
8050
=item display
8051
8052
This parameter is optional. It controls the display of runtime messages
8053
like informations or warnings. By default, all messages are displayed. You
8054
can suppress these informations partially or completely by passing one or
8055
more of the "DISPLAY_..." variables declared in B.
8056
Constants should be combined by addition.
8057
8058
=item docstreams2skip
8059
8060
by default, all document streams are made part of the result, but by this
8061
parameter one can I certain streams (all remaining ones will be
8062
streamed as usual).
8063
8064
The list should be supplied by an array reference.
8065
8066
It is suggested to take the values of this parameter from a user option,
8067
which by convention should be named C<-skipstream>.
8068
8069
=item docstreaming
8070
8071
specifies the way the parser handles stream entry points. The value passed
8072
might be either C, C or C.
8073
8074
C instructs the parser to transform the entry points
8075
into I, one level below the current real headline level. This
8076
is an easy to implement and convenient way of docstream handling seems to
8077
make sense in most target formats.
8078
8079
C hides all streams except of the main stream. The effect
8080
is similar to a call with I set for all document streams
8081
in a source.
8082
8083
C treats the entry points as entry points and streams
8084
them as such. This is the default if the parameter is omitted.
8085
8086
Please note that filters applied by I work regardless of
8087
the I configuration which only affects the way the parser
8088
passes docstream data to a backend.
8089
8090
It is recommended to take the value of this parameter from a user option,
8091
which by convention should be named C<-docstreaming>. (A converter can
8092
define various more modes than provided by the parser and implement them
8093
itself, of course. See C for a reference implementation.)
8094
8095
8096
=item files
8097
8098
a reference to an array of files to be scanned.
8099
8100
Files are treated as PerlPoint sources except when their name has the
8101
prefix C, as in C. With this prefix, the
8102
parser tries to automatically tranform the source into PerlPoint,
8103
using a standard import filter for the format indicated by the file
8104
extension (C in our example). The filter must be installed as
8105
Cuppercased format nameE>, e.g.
8106
C.
8107
8108
=item filter
8109
8110
a regular expression describing the target language. This setting, if used,
8111
prevents all embedded or included source code of other languages than the set
8112
one from inclusion into the generated stream. This accelerates both parsing
8113
and backend handling. The pattern is evaluated case insensitively.
8114
8115
Example: pass "html|perl" to allow HTML and Perl.
8116
8117
To illustrate this, imagine a translator to PostScript. If it reads a Perl
8118
Point file which includes native HTML, this translator cannot handle such code.
8119
The backend would have to skip the HTML statements. With a "PostScript" filter,
8120
the HTML code will not appear in the stream.
8121
8122
This enables PerlPoint texts prepared for various target languages. If an
8123
author really needs plain target language code to be embedded into PerlPoint,
8124
he could provide versions for various languages. Translators using a filter
8125
will then receive exactly the code of their target language, if provided.
8126
8127
Please note that you cannot filter out PerlPoint code or example files.
8128
8129
By default, no filter is set.
8130
8131
8132
=item headlineLinks
8133
8134
this optional flag causes the parser to register all headline
8135
titles as anchors automatically. (Headlines are stored without
8136
possibly included tags which are stripped off.)
8137
8138
Registering anchors does \I mean there are anchors included
8139
to the stream, it just means that they are known to exist at
8140
parsing time because they are added to an internal C
8141
object which is passed to all tag hooks and can be evaluated there.
8142
See \C and C for details.
8143
8144
It is recommended to make use of this feature if your converter
8145
automatically makes headlines an anchor named like the headline
8146
(this feature was introduced by Lorenz Domkes C initially).
8147
(Nevertheless, usefulness may depend on dealing with the parsers
8148
anchor collection in tag hooks. See the documentations of used
8149
tag modules for details.)
8150
8151
If your converter does not support automatic headline anchors
8152
the mentioned way, it is recommended to omit this option because
8153
it could confuse tag hooks that evaluate the parsers anchor collection.
8154
8155
8156
=item libpath
8157
8158
An optional reference to an array of library pathes to be searched for
8159
files specified by \INCLUDE tags. This array is intended to be filled
8160
by directories specified via an converter option. By convention, this
8161
option is named C and should be enabled multiple times
8162
(C).
8163
8164
Please note that library pathes can be set via environment variable
8165
C as well, but directories specified via C are
8166
searched I.
8167
8168
8169
=item linehints
8170
8171
If set to a true value, the parser will embed line hints into the stream
8172
whenever a new source line begins.
8173
8174
A line hint directive is provided as
8175
8176
[
8177
DIRECTIVE_NEW_LINE, DIRECTIVE_START,
8178
{file=>filename, line=>number}
8179
]
8180
8181
and is suggested to be handled by a backend callback.
8182
8183
Please note that currently source line numbers are not guaranteed to be
8184
correct if stream parts are restored from I (see there for details).
8185
8186
The default value is 0.
8187
8188
=item nestedTables
8189
8190
This is an optional flag which is by default set to 0, indicating if the parser
8191
shall accept nested tables or not. Table nesting can produce very nice results
8192
if it is supported by the target language. HTML, for example, allows to nest
8193
tables, but other languages I. So, using this feature can really improve
8194
the results if a user is focussed on supporting certain target formats only. If I want
8195
to produce nothing but HTML, why should I take care of target formats not able
8196
to handle table nesting? On the other hand, I a document shall be translated
8197
into several formats, it might cause trouble to nest tables therein.
8198
8199
Because of this, it is suggested to let converter users decide if they want to
8200
enable table nesting or not. If the target format does not support nesting, I
8201
recommend to disable nesting completely.
8202
8203
8204
=item object
8205
8206
the parser object made by I;
8207
8208
=item safe
8209
8210
an object of the B class which comes with perl. It is used to evaluate
8211
embedded Perl code in a safe environment. By letting the caller of I
8212
provide this object, a translator author can make the level of safety fully
8213
configurable by users. Usually, the following should work
8214
8215
use Safe;
8216
...
8217
$parser->run(safe=>new Safe, ...);
8218
8219
Safe is a really good module but unfortunately limited in loading modules
8220
transparently. So if a user wants to use modules in his embedded code, he
8221
might fail to get it working in a Safe compartment. If safety does not matter,
8222
he can decide to execute it without Safe, with full Perl access. To switch
8223
on this mode, pass a true scalar value (but no reference) instead of a Safe
8224
object.
8225
8226
To make all PerlPoint converters behave similarly, it is recommended to provide
8227
two related options C<-activeContents> and C<-safeOpcode>. C<-activeContents>
8228
should flag that active contents shall be evaluated, while C<-safeOpcode>
8229
controls the level of security. A special level C should mean that all
8230
code can b executed without any restriction, while any other settings should be
8231
treated as an opcode to configure the Safe object. So, the recommended rules
8232
are: pass 0 unless C<-activeContents> is set. Pass 1 if the converter was
8233
called with C<-activeContents> I C<-safeOpcode ALL>. Pass a Safe object
8234
and configure it according to the users C<-safeOpcode> settings if
8235
C<-activeContents> is used but without C<-safeOpcode ALL>. See C
8236
for an implementation example.
8237
8238
Active Perl contents is I if this setting is omitted or if anything
8239
else than a B object is passed. (There are currently three types of active
8240
contents: embedded or included Perl and condition paragraphs.)
8241
8242
8243
=item predeclaredVars
8244
8245
Variables are usually set by assignment paragraphs. However, it may be useful
8246
for a converter to predeclare a set of them to provide certain settings to the
8247
users. Predeclared variables, as any other PerlPoint variables, can be used
8248
both in pure PerlPoint and in active contents. To help users distinguish them
8249
from user defined vars, their names will be I.
8250
8251
Just pass a hash of variable name / value pairs:
8252
8253
$parser->run(
8254
...
8255
predeclaredVars => {
8256
CONVERTER_NAME => 'pp2xy',
8257
CONVERTER_VERSION => $VERSION,
8258
...
8259
},
8260
);
8261
8262
Non capitalized variable names will be capitalized without further notice.
8263
8264
Please note that variables currently can only be scalars. Different data types
8265
will not be accepted by the parser.
8266
8267
Predeclared variables should be mentioned in the converters documentation.
8268
8269
The parser itself makes use of this feature by declaring C<_PARSER_VERSION>
8270
(the version of this module used to parse the source) and _STARTDIR (the full
8271
path of the startup directory, as reported by C).
8272
8273
C needs C to take effect.
8274
8275
8276
=item skipcomments
8277
8278
By default comments are streamed and can be converted into comments of the target language.
8279
But often they are of limited use in generated files: especially if they are intended to
8280
help the author of a document, not the reader of the source of generated results. So with
8281
this option one can suppress comments from being streamed.
8282
8283
It is suggested to get this setting via user option,
8284
which by convention should be named C<-skipcomments>.
8285
8286
=item stream
8287
8288
A reference to an array where the generated output stream should be stored in.
8289
8290
Application programmers may want to tie this array if the target ASCII
8291
texts are expected to be large (long ASCII texts can result in large stream
8292
data which may occupy a lot of memory). Because of the fact that the parser
8293
stores stream data I, memory consumption can be reduced
8294
significantly by tying the stream array.
8295
8296
It is recommended to pass an empty array. Stored data will not be overwritten,
8297
the parser I its data instead (by C).
8298
8299
=item trace
8300
8301
This parameter is optional. It is intended to activate trace code while the method
8302
runs. You may pass any of the "TRACE_..." constants declared in B,
8303
combined by addition as in the following example:
8304
8305
# show the traces of both
8306
# lexical and syntactical analysis
8307
trace => TRACE_LEXER+TRACE_PARSER,
8308
8309
If you omit this parameter or pass TRACE_NOTHING, no traces will be displayed.
8310
8311
=item var2stream
8312
8313
If set to a true value, the parser will propagate variable settings into the stream
8314
by adding additional C directives.
8315
8316
A variable propagation has the form
8317
8318
[
8319
DIRECTIVE_VARSET, DIRECTIVE_START,
8320
{var=>varname, value=>value}
8321
]
8322
8323
and is suggested to be handled by a backend callback.
8324
8325
The default value is 0.
8326
8327
=item vispro
8328
8329
activates "process visualization" which simply means that a user will see
8330
progress messages while the parser processes documents. The I
8331
value of this setting determines how often the progress message shall be
8332
updated, by a I:
8333
8334
# inform every five chapters
8335
vispro => 5,
8336
8337
Process visualization is automatically suppressed unless STDERR is
8338
connected to a terminal, if this option is omitted, I was set
8339
to C or parser Is are activated.
8340
8341
=back
8342
8343
B
8344
A "true" value in case of success, "false" otherwise. A call is performed
8345
successfully if there was neither a syntactical nor a semantic error in the
8346
parsed files.
8347
8348
B
8349
8350
$parser->run(
8351
stream => \@streamData,
8352
files => \@ARGV,
8353
filter => 'HTML',
8354
cache => CACHE_ON,
8355
trace => TRACE_PARAGRAPHS,
8356
);
8357
8358
=cut
8359
sub run
8360
{
8361
# get parameters
8362
my ($me, @pars)=@_;
8363
8364
# build parameter hash
8365
confess "[BUG] The number of parameters should be even.\n" if @pars%2;
8366
my %pars=@pars;
8367
8368
# and check parameters
8369
confess "[BUG] Missing object parameter.\n" unless $me;
8370
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and ref $me eq __PACKAGE__;
8371
confess "[BUG] Missing stream array reference parameter.\n" unless $pars{stream};
8372
confess "[BUG] Stream array reference parameter is no array reference.\n" unless ref $pars{stream} and ref $pars{stream} eq 'ARRAY';
8373
confess "[BUG] Missing file list reference parameter.\n" unless $pars{files};
8374
confess "[BUG] File list reference parameter is no array reference.\n" unless ref $pars{files} and ref $pars{files} eq 'ARRAY';
8375
confess "[BUG] You should pass at least one file to parse.\n" unless @{$pars{files}};
8376
confess "[BUG] Active base data reference is no hash reference.\n" if exists $pars{activeBaseData} and ref $pars{activeBaseData} ne 'HASH';
8377
confess "[BUG] Active data initializer is no code reference.\n" if exists $pars{activeDataInit} and ref $pars{activeDataInit} ne 'CODE';
8378
confess "[BUG] Document stream skip list is no array reference.\n" if exists $pars{docstreams2skip} and ref $pars{docstreams2skip} ne 'ARRAY';
8379
if (exists $pars{filter})
8380
{
8381
eval "'lang'=~/$pars{filter}/";
8382
confess qq([BUG] Invalid filter expression "$pars{filter}": $@.\n) if $@;
8383
}
8384
8385
# variables
8386
my ($rc, %docHints)=(1);
8387
8388
# init internal data
8389
(
8390
$resultStreamRef, # 1
8391
$safeObject, # 2
8392
$flags{trace}, # 3
8393
$flags{display}, # 4
8394
$flags{filter}, # 5
8395
$flags{linehints}, # 6
8396
$flags{var2stream}, # 7
8397
$flags{cache}, # 8
8398
$flags{cached}, # 9
8399
$flags{vis}, # 10
8400
$flags{activeBaseData}, # 11
8401
$flags{activeDataInit}, # 12
8402
$flags{nestedTables}, # 13
8403
$flags{headlineLinks}, # 14
8404
$flags{skipcomments}, # 15
8405
$flags{docstreams2skip}, # 16
8406
$flags{docstreaming}, # 17
8407
$flags{criticalSemantics}, # 18
8408
$macroChecksum, # 19
8409
$varChecksum, # 20
8410
$anchors, # 21
8411
)=(
8412
$pars{stream}, # 1
8413
( # 2
8414
exists $pars{safe}
8415
and defined $pars{safe}
8416
) ? ref($pars{safe}) eq 'Safe' ? $pars{safe}
8417
: 1
8418
: 0,
8419
exists $pars{trace} ? $pars{trace} : TRACE_NOTHING, # 3
8420
exists $pars{display} ? $pars{display} : DISPLAY_ALL, # 4
8421
exists $pars{filter} ? $pars{filter} : '', # 5
8422
(exists $pars{linehints} and $pars{linehints}), # 6
8423
(exists $pars{var2stream} and $pars{var2stream}), # 7
8424
exists $pars{cache} ? $pars{cache} : CACHE_OFF, # 8
8425
0, # 9
8426
exists $pars{vispro} ? $pars{vispro} : 0, # 10
8427
exists $pars{activeBaseData} ? $pars{activeBaseData} : 0, # 11
8428
exists $pars{activeDataInit} ? $pars{activeDataInit} : 0, # 12
8429
exists $pars{nestedTables} ? $pars{nestedTables} : 0, # 13
8430
exists $pars{headlineLinks} ? $pars{headlineLinks} : 0, # 14
8431
(exists $pars{skipcomments} and $pars{skipcomments}), # 15
8432
exists $pars{docstreams2skip} ? {map {($_ => undef)} @{$pars{docstreams2skip}}} : 0, # 16
8433
exists $pars{docstreaming} ? $pars{docstreaming} : DSTREAM_DEFAULT, # 17
8434
exists $pars{criticalSemanticErrors} ? $pars{criticalSemanticErrors} : 0, # 18
8435
0, # 19
8436
0, # 20
8437
PerlPoint::Anchors->new, # 21
8438
);
8439
8440
# prepare stream data structure and appropriate handlers
8441
unless (@$resultStreamRef and $resultStreamRef->[STREAM_IDENT] eq '__PerlPoint_stream__')
8442
{
8443
# empty stream
8444
@$resultStreamRef=();
8445
# initiate
8446
@{$resultStreamRef}[
8447
STREAM_IDENT,
8448
STREAM_TOKENS,
8449
STREAM_HEADLINES,
8450
]=(
8451
'__PerlPoint_stream__', # stream identifier;
8452
[], # base stream;
8453
[], # headline stream;
8454
);
8455
}
8456
8457
# declare helper subroutines to be used in active contents
8458
if ($safeObject)
8459
{
8460
my $code=<<'EOC';
8461
8462
unless (defined *main::flagSet{CODE})
8463
{
8464
# check if at least one of a set of flags is set
8465
# - define functions anonymously to avoid redefinition in case the condition is not matched
8466
*main::flagSet=sub
8467
{
8468
# declare and init variable
8469
my $rc=0;
8470
8471
# check flags
8472
foreach (@_)
8473
{$rc=1, last if exists $PerlPoint->{userSettings}{$_};}
8474
8475
# supply result
8476
$rc;
8477
};
8478
8479
# provide the value of a PerlPoint variable
8480
# - define function anonymously to avoid redefinition in case the condition is not matched
8481
*main::varValue=sub {${join('::', 'main', $_[0])};};
8482
}
8483
8484
# complete compartment code
8485
EOC
8486
8487
ref($safeObject) ? $safeObject->reval($code) : eval("{package main; no strict; $code}");
8488
die "[BUG] Bug in function definition, please inform developer: $@" if $@;
8489
}
8490
8491
# predeclare variables
8492
_predeclareVariables({_PARSER_VERSION=>$PerlPoint::Parser::VERSION, _STARTDIR=>cwd()});
8493
8494
# store initial variables, if necessary
8495
if (exists $pars{predeclaredVars})
8496
{
8497
# check data format
8498
confess "[BUG] Please pass predeclared variables by a hash reference .\n" unless ref($pars{predeclaredVars}) eq 'HASH';
8499
8500
# declare
8501
_predeclareVariables($pars{predeclaredVars});
8502
}
8503
8504
# update visualization flag
8505
$flags{vis}=0 unless $flags{vis}
8506
and not $flags{display} & &DISPLAY_NOINFO
8507
and not $flags{trace}>TRACE_NOTHING
8508
and -t STDERR;
8509
8510
# init more
8511
@flags{qw(skipInput headlineLevelOffset headlineLevel olist virtualParagraphStart)}=(0) x 5;
8512
delete $flags{ifilters};
8513
$statistics{cache}[1]=0 if $flags{cache} & CACHE_ON;
8514
8515
# init even more
8516
%paragraphTypeStrings=(
8517
DIRECTIVE_HEADLINE() => 'headline',
8518
DIRECTIVE_TEXT() => 'text',
8519
DIRECTIVE_UPOINT() => 'unordered list point',
8520
DIRECTIVE_ULIST() => 'list',
8521
DIRECTIVE_OPOINT() => 'ordered list point',
8522
DIRECTIVE_OLIST() => 'list',
8523
DIRECTIVE_DPOINT() => 'definition list point',
8524
DIRECTIVE_DLIST() => 'list',
8525
DIRECTIVE_BLOCK() => 'block',
8526
DIRECTIVE_VERBATIM() => 'verbatim block',
8527
DIRECTIVE_TAG() => 'tag',
8528
DIRECTIVE_LIST_RSHIFT() => 'right list shifter',
8529
DIRECTIVE_LIST_LSHIFT() => 'left list shifter',
8530
DIRECTIVE_COMMENT() => 'comment',
8531
);
8532
# check tag declarations
8533
unless (ref($PerlPoint::Tags::tagdefs) eq 'HASH')
8534
{
8535
# warn user
8536
warn "[Warn] No tags are declared. No tags will be detected.\n" unless $flags{display} & DISPLAY_NOWARN;
8537
8538
# init shortcut pointer
8539
$tagsRef={};
8540
}
8541
else
8542
{
8543
# ok, there are tags, make a shortcut
8544
$tagsRef=$PerlPoint::Tags::tagdefs;
8545
}
8546
8547
# build an array of include pathes - specified via environment variable PERLPOINTLIB
8548
# and parameter "libpath"
8549
confess "[BUG] Please pass library pathes by an array reference .\n" if exists $pars{libpath} and not ref($pars{libpath}) eq 'ARRAY';
8550
push(@libraryPath,
8551
exists $pars{libpath} ? @{$pars{libpath}} : (),
8552
exists $ENV{PERLPOINTLIB} ? split(/\s*;\s*/, $ENV{PERLPOINTLIB}) : (),
8553
);
8554
8555
# welcome user
8556
unless ($flags{display} & DISPLAY_NOINFO)
8557
{
8558
print STDERR "[Info] The PerlPoint parser ";
8559
{
8560
no strict 'refs';
8561
print STDERR ${join('::', __PACKAGE__, 'VERSION')};
8562
}
8563
warn " starts.\n";
8564
warn " Active contents is ", $safeObject ? ref($safeObject) ? 'safely evaluated' : 'risky evaluated' : 'ignored', ".\n";
8565
8566
# report cache mode
8567
warn " Paragraph cache is ", ($flags{cache} & CACHE_ON) ? '' : 'de', "activated.\n";
8568
}
8569
8570
# save current directory
8571
my $startupDirectory=cwd();
8572
8573
# scan all input files
8574
foreach my $file (@{$pars{files}})
8575
{
8576
# scopies
8577
my $specifiedFile=$file;
8578
8579
# scan for an import directive
8580
if ($file=~/^IMPORT:(.+)/)
8581
{
8582
# replace the original file by a temporary one ...
8583
my ($tmpHandle, $tmpFilename)=tempfile(UNLINK => ($flags{trace} & TRACE_TMPFILES ? 0 : 1));
8584
$file=$tmpFilename;
8585
8586
# which imports the real file
8587
my $realfile=abs_path($specifiedFile=$1);
8588
print $tmpHandle qq(\n\n\\INCLUDE{import=1 file="$realfile"}\n\n);
8589
close($tmpHandle);
8590
8591
# due to the extra level chances are we have to to accept a first paragraph that is not a headline
8592
$flags{complainedAbout1stHeadline}='IMPORT' unless exists $flags{complainedAbout1stHeadline} and $flags{complainedAbout1stHeadline} eq '1';
8593
}
8594
8595
# inform user
8596
warn "[Info] Processing $specifiedFile ...\n" unless $flags{display} & DISPLAY_NOINFO;
8597
8598
# init input stack
8599
@inputStack=([]);
8600
8601
# init nesting stack
8602
@nestedSourcefiles=($file);
8603
8604
# update source file nesting level hint
8605
_predeclareVariables({_SOURCE_LEVEL=>scalar(@nestedSourcefiles)});
8606
8607
# update file hint
8608
$sourceFile=$file;
8609
8610
# open file and make the new handle the parsers input
8611
open($inHandle, $file) or confess("[Fatal] Could not open input file $file.\n");
8612
binmode($inHandle);
8613
8614
# store the filename in the list of opened sources, to avoid circular reopening
8615
# (it would be more perfect to store the complete path, is there a module for this?)
8616
$openedSourcefiles{$file}=1;
8617
8618
# change into the source directory
8619
chdir(dirname($file));
8620
8621
# (cleanup and) read old checksums as necessary
8622
my $cachefile=sprintf(".%s.ppcache", basename($file));
8623
if (($flags{cache} & CACHE_CLEANUP) and -e $cachefile)
8624
{
8625
warn " Resetting paragraph cache for $specifiedFile.\n" unless $flags{display} & DISPLAY_NOINFO;
8626
unlink($cachefile);
8627
}
8628
if (($flags{cache} & CACHE_ON) and -e $cachefile)
8629
{
8630
$checksums=retrieve($cachefile) ;
8631
#use Data::Dumper; warn Dumper($checksums);
8632
8633
# clean up old format caches
8634
unless (
8635
exists $checksums->{sha1_base64('version')}
8636
and $checksums->{sha1_base64('version')}>=0.38
8637
8638
and exists $checksums->{sha1_base64('constants')}
8639
and $checksums->{sha1_base64('constants')}==$PerlPoint::Constants::VERSION
8640
8641
and exists $checksums->{sha1_base64('Storable')}
8642
and $checksums->{sha1_base64('Storable')}==$Storable::VERSION
8643
)
8644
{
8645
warn " Paragraph cache for $specifiedFile is rebuilt because of an old format.\n" unless $flags{display} & DISPLAY_NOINFO;
8646
unlink($cachefile);
8647
$checksums={};
8648
}
8649
}
8650
8651
# store cache builder version and constant declarations version
8652
if ($flags{cache} & CACHE_ON)
8653
{
8654
$checksums->{sha1_base64('version')}=$PerlPoint::Parser::VERSION;
8655
$checksums->{sha1_base64('constants')}=$PerlPoint::Constants::VERSION;
8656
$checksums->{sha1_base64('Storable')}=$Storable::VERSION;
8657
}
8658
8659
# store a document start directive (done here to save memory)
8660
push(@{$resultStreamRef->[STREAM_TOKENS]}, [\%docHints, DIRECTIVE_DOCUMENT, DIRECTIVE_START, basename($file)]);
8661
8662
# update tag finish memory by the way
8663
_updateTagFinishMem(scalar(@{$resultStreamRef->[STREAM_TOKENS]}));
8664
8665
# enter first (and most common) lexer state
8666
_stateManager(STATE_DEFAULT);
8667
8668
# flag that the next paragraph can be checksummed, if so
8669
$flags{checksum}=1 if $flags{cache} & CACHE_ON;
8670
8671
# set a timestamp, if helpful
8672
$flags{started}=time unless $flags{display} & DISPLAY_NOINFO;
8673
8674
# parse input
8675
$rc=($rc and $me->YYParse(yylex=>\&_lexer, yyerror=>\&_Error, yydebug => ($flags{trace} & TRACE_PARSER) ? 0x1F : 0x00));
8676
8677
# stop time, if necessary
8678
warn "\n $specifiedFile was parsed in ", time-$flags{started}, " seconds.\n" unless $flags{display} & DISPLAY_NOINFO;
8679
8680
# store a document completion directive (done here to save memory)
8681
push(@{$resultStreamRef->[STREAM_TOKENS]}, [\%docHints, DIRECTIVE_DOCUMENT, DIRECTIVE_COMPLETE, basename($file)]);
8682
8683
# reset the input handle and flags
8684
$readCompletely=0;
8685
8686
# store checksums, if necessary
8687
store($checksums, $cachefile) if ($flags{cache} & CACHE_ON)
8688
and $flags{cached}
8689
and defined $checksums and %$checksums;
8690
8691
# close the input file
8692
close($inHandle);
8693
$inHandle=new IO::File;
8694
8695
# back to startup directory
8696
chdir($startupDirectory);
8697
}
8698
8699
8700
# make a simple helper backend object
8701
my $helperBackend=new PerlPoint::Backend(
8702
name => 'parsers helper backend',
8703
display => DISPLAY_NOINFO+DISPLAY_NOWARN,
8704
8705
trace => TRACE_NOTHING,
8706
);
8707
8708
# get toc
8709
$helperBackend->bind($resultStreamRef);
8710
my $toc=$helperBackend->toc;
8711
8712
# store headlines as anchors, if necessary
8713
if (@$toc and $flags{headlineLinks})
8714
{
8715
# scopies
8716
my ($headlineNr, @headlinePath)=(0);
8717
8718
foreach (@$toc)
8719
{
8720
# update headline counter
8721
$headlineNr++;
8722
8723
# get data
8724
my ($level, $title)=@$_;
8725
8726
# skip empty headlines
8727
next unless $title;
8728
8729
# update headline path and numbers
8730
$headlinePath[$level]=$title;
8731
8732
# store both plain and composite headlines in the anchor object
8733
$anchors->add($title, $title, $headlineNr);
8734
$anchors->add(join('|', map {defined($_) ? $_ : ''} @headlinePath[$_..$level]), $title, $headlineNr) for (1..$level-1);
8735
}
8736
}
8737
8738
# add complete headline titles to streamed headline tokens,
8739
# move abbreviation, docstream and variable hints into data section
8740
if (@$toc)
8741
{
8742
# scopy
8743
my (@headlinePath, @shortcutPath, @levelPath, @pagenumPath);
8744
8745
for (my $index=0; $index<=$#{$toc}; ++$index)
8746
{
8747
# build a more readable shortcut
8748
my $ref=$resultStreamRef->[STREAM_TOKENS][$resultStreamRef->[STREAM_HEADLINES][$index]];
8749
8750
# get toc data
8751
my ($level, $title)=@{$toc->[$index]};
8752
8753
# adapt arrays to get rid of previous data - important in case someone skips several levels
8754
# (jumping from level 5 to 100 etc.)
8755
$#headlinePath=$#shortcutPath=$#levelPath=$#pagenumPath=$level;
8756
8757
# update headline pathes and numbers
8758
$headlinePath[$level]=$title;
8759
$shortcutPath[$level]=$ref->[0]{shortcut} ? $ref->[0]{shortcut} : $title;
8760
$levelPath[$level]++;
8761
$pagenumPath[$level]=$index+1; # real page number, no index
8762
8763
my $docstreams=delete($ref->[0]{docstreams});
8764
my $variables=delete($ref->[0]{vars});
8765
push (
8766
@$ref,
8767
$toc->[$index][1],
8768
delete($ref->[0]{shortcut}),
8769
$flags{docstreaming}==DSTREAM_DEFAULT ? [sort keys %$docstreams] : {},
8770
8771
# store headline path data in the streamed token
8772
[
8773
dclone([@headlinePath[1..$level]]),
8774
dclone([@shortcutPath[1..$level]]),
8775
dclone([@levelPath[1..$level]]),
8776
dclone([@pagenumPath[1..$level]]),
8777
$variables,
8778
],
8779
);
8780
}
8781
}
8782
8783
# finish tags, if necessary
8784
if (@$pendingTags==3)
8785
{
8786
# get number of tokens
8787
my $lastIndex=$#{$resultStreamRef->[STREAM_TOKENS]};
8788
8789
# handle all marked sections
8790
foreach my $section (@{$pendingTags->[2]})
8791
{
8792
# scan the stream till all pending tags were handled,
8793
# begin as near as possible
8794
for (my $position=$section->[0]; $position<=$lastIndex; $position++)
8795
{
8796
# get token
8797
my $token=$resultStreamRef->[STREAM_TOKENS][$position];
8798
8799
# skip everything except tag beginners of tags with finish hooks
8800
next unless ref($token)
8801
and $token->[STREAM_DIR_TYPE]==DIRECTIVE_TAG
8802
and $token->[STREAM_DIR_STATE]==DIRECTIVE_START
8803
and exists $tagsRef->{$token->[STREAM_DIR_DATA]}{finish};
8804
8805
# make an option hash
8806
my $options=dclone($token->[STREAM_DIR_DATA+1]);
8807
8808
# call hook function (use eval() to guard yourself)
8809
my $rc;
8810
eval {$rc=&{$tagsRef->{$token->[STREAM_DIR_DATA]}{finish}}($options, $anchors, join('-', @headlineIds))};
8811
8812
# check result
8813
unless ($@)
8814
{
8815
{
8816
# Error? (Treat syntactic errors as semantic ones at this point to give PARSING_FAILED a meaning.)
8817
++$_semerr, last if $rc==PARSING_ERROR or $rc==PARSING_FAILED;
8818
8819
# update options (might be modified, and checking for a difference
8820
# might take more time then just copying the replied values)
8821
$token->[STREAM_DIR_DATA+1]=$options;
8822
8823
# all right? (several values just mean "ok" at this point)
8824
last if $rc==PARSING_OK or $rc==PARSING_COMPLETED;
8825
8826
# backend hints to store?
8827
$token->[STREAM_DIR_HINTS]{ignore}=1, last if $rc==PARSING_IGNORE;
8828
$token->[STREAM_DIR_HINTS]{hide}=1, last if $rc==PARSING_ERASE;
8829
8830
# something is wrong here
8831
warn "[Warn] Tags ", $token->[STREAM_DIR_DATA], " tag finish hook replied unexpected result $rc, ignored.\n";
8832
}
8833
}
8834
else
8835
{warn "[Warn] Error in tags ", $token->[STREAM_DIR_DATA], " finish hook (ignored): $@\n"}
8836
8837
# update counter and leave loop if all pending tags in this section were handled
8838
last unless --$section->[1];
8839
}
8840
}
8841
}
8842
8843
# clean up
8844
undef $pendingTags;
8845
8846
8847
# success?
8848
if ($rc and not $_semerr)
8849
{
8850
# display a summary
8851
warn <
8852
8853
[Info] Input ok.
8854
8855
Statistics:
8856
-----------
8857
${\(_statisticsHelper(DIRECTIVE_HEADLINE))},
8858
${\(_statisticsHelper(DIRECTIVE_TEXT))},
8859
${\(_statisticsHelper(DIRECTIVE_UPOINT))},
8860
${\(_statisticsHelper(DIRECTIVE_OPOINT))},
8861
${\(_statisticsHelper(DIRECTIVE_DPOINT))},
8862
${\(_statisticsHelper(DIRECTIVE_BLOCK))},
8863
${\(_statisticsHelper(DIRECTIVE_VERBATIM))},
8864
${\(_statisticsHelper(DIRECTIVE_TAG))}
8865
${\(_statisticsHelper(DIRECTIVE_LIST_RSHIFT))},
8866
${\(_statisticsHelper(DIRECTIVE_LIST_LSHIFT))},
8867
and ${\(_statisticsHelper(DIRECTIVE_COMMENT))} were detected.
8868
8869
EOM
8870
8871
# add cache informations, if necessary
8872
warn ' ' x length('[Info] '), int(100*$statistics{cache}[1]/$statistics{cache}[0]+0.5), "% of all checked paragraphs were restored from cache.\n\n" if $flags{cache} & CACHE_ON and not $flags{display} & DISPLAY_NOINFO;
8873
}
8874
else
8875
{
8876
# display a summary
8877
warn "[Info] Input contains $_semerr semantic error", $_semerr>1?'s':'', ".\n" if $_semerr;
8878
}
8879
8880
# inform user
8881
warn "[Info] Parsing completed.\n\n" unless $flags{display} & DISPLAY_NOINFO;
8882
8883
# reply success state
8884
$rc and not $_semerr;
8885
}
8886
8887
8888
# report a semantic error, terminate process if necessary
8889
sub _semerr
8890
{
8891
my $parser=shift;
8892
warn "[Error ", ++$_semerr, "] ", @_, "\n";
8893
$parser->YYAbort if $flags{criticalSemantics};
8894
}
8895
8896
# ------------------------------------------------------
8897
# A tiny helper function intended for internal use only.
8898
# ------------------------------------------------------
8899
sub _statisticsHelper
8900
{
8901
# get and check parameters
8902
my ($type)=@_;
8903
confess "[BUG] Missing type parameter.\n" unless defined $type;
8904
8905
# declare variables
8906
my ($nr)=(exists $statistics{$type} and $statistics{$type}) ? $statistics{$type} : 0;
8907
8908
# reply resulting string
8909
join('', "$nr ", $paragraphTypeStrings{$type}, $nr==1 ? '' : 's');
8910
}
8911
8912
sub _updateChecksums
8913
{
8914
# get and check parameters
8915
my ($streamPart, $parserReinvokationHint)=@_;
8916
confess "[BUG] Missing stream part parameter.\n" unless defined $streamPart;
8917
confess "[BUG] Stream part parameter is no reference.\n" unless ref($streamPart);
8918
8919
# certain paragraph types are not cached intentionally
8920
return if not ($flags{cache} & CACHE_ON)
8921
or exists {
8922
DIRECTIVE_COMMENT() => 1,
8923
}->{$streamPart->[0][STREAM_DIR_TYPE]};
8924
8925
if (exists $flags{checksummed} and $flags{checksummed})
8926
{
8927
$checksums->{$sourceFile}{$flags{checksummed}[0]}=[
8928
dclone($streamPart),
8929
$flags{checksummed}[2],
8930
$parserReinvokationHint ? $parserReinvokationHint : (),
8931
defined $flags{checksummed}[3] ? $macroChecksum : (),
8932
defined $flags{checksummed}[4] ? $varChecksum : (),
8933
$anchors->reportNew,
8934
];
8935
# use Data::Dumper;
8936
# warn Dumper($streamPart);
8937
$flags{checksummed}=undef;
8938
8939
# note that something new was cached
8940
$flags{cached}=1;
8941
}
8942
}
8943
8944
8945
# --------------------------------------------------------
8946
# Extend all table rows to the number of columns found
8947
# in the first table line ("table headline"). On request,
8948
# automatically format the first table line as "headline".
8949
# --------------------------------------------------------
8950
sub _normalizeTableRows
8951
{
8952
# get and check parameters
8953
my ($stream, $autoHeadline)=@_;
8954
confess "[BUG] Missing stream part reference parameter.\n" unless defined $stream;
8955
confess "[BUG] Stream part reference parameter is no array reference.\n" unless ref($stream) eq 'ARRAY';
8956
confess "[BUG] Missing headline mode parameter.\n" unless defined $autoHeadline;
8957
8958
# declare variables
8959
my ($refColumns, $maxColumns, $columns, $nested, @flags, @improvedStream)=(0, 0, 0.5, 0, 1);
8960
8961
# remove whitespaces at the beginning and end of the stream, if necessary
8962
shift(@$stream) if $stream->[0]=~/^\s*$/; $stream->[0]=~s/^\s+//;
8963
pop(@$stream) if $stream->[-1]=~/^\s*$/; $stream->[-1]=~s/\s+$//;
8964
8965
# process the received stream
8966
foreach (@$stream)
8967
{
8968
# search for *embedded* tables - which are already normalized!
8969
$nested+=($_->[STREAM_DIR_STATE]==DIRECTIVE_START ? 1 : -1)
8970
if ref($_) eq 'ARRAY' and $_->[STREAM_DIR_TYPE]==DIRECTIVE_TAG and $_->[STREAM_DIR_DATA] eq 'TABLE';
8971
8972
# Inside an embedded table? Just pass the stream unchanged then.
8973
push(@improvedStream, $_), next if $nested;
8974
8975
# check state, set flags
8976
$flags[1]=(ref($_) eq 'ARRAY' and $_->[STREAM_DIR_TYPE]==DIRECTIVE_TAG);
8977
$flags[2]=($flags[1] and $_->[STREAM_DIR_DATA] eq 'TABLE_COL');
8978
$flags[3]=($flags[1] and $_->[STREAM_DIR_STATE]==DIRECTIVE_COMPLETE and $_->[STREAM_DIR_DATA] eq 'TABLE_ROW');
8979
$flags[4]=1 if $flags[2] and $_->[STREAM_DIR_STATE]==DIRECTIVE_START;
8980
$flags[4]=0 if $flags[2] and $_->[STREAM_DIR_STATE]==DIRECTIVE_COMPLETE;
8981
8982
# update counter of current row columns
8983
$columns+=0.5 if $flags[2];
8984
8985
# end of column reached?
8986
if ($flags[2] and not $flags[4])
8987
{
8988
# remove all trailing whitespaces in the last recent data entry,
8989
# remove data which becomes empty this way
8990
$improvedStream[-1]=~s/\s+$//;
8991
pop(@improvedStream) unless length($improvedStream[-1]);
8992
}
8993
8994
# first data after opening a new column?
8995
if ($flags[4] and not $flags[2])
8996
{
8997
# reset flag
8998
$flags[4]=0;
8999
9000
# remove all leading whitespaces, skip data which becomes empty this way
9001
s/^\s+//;
9002
next unless length($_);
9003
}
9004
9005
# table headline row?
9006
if ($flags[0])
9007
{
9008
# ok: mark columns as headline parts if necessary, take other elements unchanged
9009
push(@improvedStream, ($flags[2] and $autoHeadline) ? [@{$_}[STREAM_DIR_HINTS .. STREAM_DIR_STATE], 'TABLE_HL'] : $_);
9010
# at the end of this first row, marks that it is reached, store the number
9011
# of its columns as a reference for the complete table, and reset the column counter
9012
# (which will be used slightly differently in the following lines)
9013
$flags[0]=0, $refColumns=$maxColumns=$columns, $columns=0 if $flags[3];
9014
}
9015
else
9016
{
9017
# this is a content row (take care to preserve the order of operations here)
9018
9019
# end of table row reached?
9020
if ($flags[3])
9021
{
9022
# yes: insert additional columns, if necessary
9023
push(
9024
@improvedStream,
9025
[{}, DIRECTIVE_TAG, DIRECTIVE_START, 'TABLE_COL'],
9026
[{}, DIRECTIVE_TAG, DIRECTIVE_COMPLETE, 'TABLE_COL'],
9027
) for 1 .. ($refColumns-$columns);
9028
9029
# reset column counter
9030
$columns=0;
9031
}
9032
9033
# update maximum number of columns, if necessary
9034
$maxColumns=$columns if $columns>$maxColumns;
9035
9036
# in any case, copy this stream part
9037
push(@improvedStream, $_);
9038
}
9039
}
9040
9041
# replace original stream by the improved variant
9042
@$stream=@improvedStream;
9043
9044
# supply the number of columns in the table row *and* the maximum number of columns
9045
($refColumns, $maxColumns);
9046
}
9047
9048
9049
# predeclare variables
9050
sub _predeclareVariables
9051
{
9052
# get and check parameters
9053
my ($declarations, $preserveNames)=@_;
9054
confess "[BUG] Missing declaration parameter.\n" unless defined $declarations;
9055
confess "[BUG] Declaration parameter is no hash reference.\n" unless ref($declarations) eq 'HASH';
9056
9057
# transform variable names, if necessary
9058
{
9059
my $c=0;
9060
%$declarations=map {$c++; $c%2 ? uc : $_} %$declarations unless $preserveNames;
9061
}
9062
9063
# handle every setting (keys are sorted for test puposes only, to make the stream reproducable)
9064
foreach my $var (sort {$a cmp $b} keys %$declarations)
9065
{
9066
# check data format
9067
confess "[BUG] Predeclared variable $var is no scalar.\n" if ref($declarations->{$var});
9068
9069
# store the variable - with an uppercased name
9070
$variables{$var}=$declarations->{$var};
9071
9072
# propagate the setting to the stream, if necessary
9073
push(@{$resultStreamRef->[STREAM_TOKENS]}, [{}, DIRECTIVE_VARSET, DIRECTIVE_START, {var=>$var, value=>$declarations->{$var}}]) if $flags{var2stream};
9074
9075
# make the new variable setting available to embedded Perl code, if necessary
9076
if ($safeObject)
9077
{
9078
no strict 'refs';
9079
${join('::', ref($safeObject) ? $safeObject->root : 'main', $var)}=$declarations->{$var};
9080
}
9081
}
9082
9083
# update tag finish memory by the way
9084
_updateTagFinishMem(scalar(@{$resultStreamRef->[STREAM_TOKENS]}));
9085
}
9086
9087
9088
# update tag finish memory
9089
sub _updateTagFinishMem
9090
{
9091
# get and check parameters
9092
my ($lastKnownStreamIndex)=@_;
9093
confess "[BUG] Missing last known stream index parameter.\n" unless defined $lastKnownStreamIndex;
9094
9095
# update tag finish memory, if necessary
9096
if ($pendingTags->[1])
9097
{
9098
# store current collection
9099
push(@{$pendingTags->[2]}, [@{$pendingTags}[0, 1]]);
9100
9101
# reset tag counter
9102
$pendingTags->[1]=0;
9103
}
9104
9105
# in any case, update the "last known index" memory
9106
$pendingTags->[0]=$lastKnownStreamIndex;
9107
}
9108
9109
9110
9111
# set import filter, if necessary (by setting an import function - a user function is *not* overwritten!)
9112
sub _setImportFilter
9113
{
9114
# get and check parameters
9115
my ($parser, $optionHash)=@_;
9116
confess "[BUG] Missing parser parameter.\n" unless $parser;
9117
confess "[BUG] Missing option hash parameter.\n" unless defined $optionHash;
9118
confess "[BUG] Option hash parameter is no hash reference.\n" unless ref($optionHash) eq 'HASH';
9119
9120
# anything to do?
9121
if (
9122
not exists $optionHash->{ifilter} # there is no functional import filter set yet
9123
and exists $optionHash->{import} # but there is a type specific import filter set yet
9124
and not ( # and there is not ...
9125
exists $flags{ifilters}{lc($optionHash->{import})} # ... a general import filter known yet
9126
and not defined $flags{ifilters}{lc($optionHash->{import})} # ... which flags that there is no such filter
9127
)
9128
)
9129
{
9130
# parser options allow to use input filters of other languages, if this is the case we find that the
9131
# value of the general import filter is a special string which holds the name of that language
9132
my $filterLang=lc(
9133
(
9134
exists $flags{ifilters}{lc($optionHash->{import})}
9135
and $flags{ifilters}{lc($optionHash->{import})}=~/^MAP:\s*(\w+)$/
9136
) ? $flags{ifilters}{lc($1)} : $optionHash->{import}
9137
);
9138
9139
# first time we need this import filter?
9140
unless (exists $flags{ifilters}{$filterLang})
9141
{
9142
# so, there is a chance to find such a filter via general modules, search for such a module
9143
eval
9144
{
9145
# no strict subs
9146
no strict;
9147
9148
# build module name
9149
my $moduleName=join('::', 'PerlPoint::Import', uc($filterLang));
9150
9151
# try to load the module
9152
my $evalCode="require $moduleName;";
9153
ref($safeObject) ? $safeObject->reval($evalCode) : eval $evalCode;
9154
die $@ if $@;
9155
9156
# check for the import function specified by the API, store the code reference to the function
9157
# found or the undefined value otherwise, which will avoid repeated searches (store it both
9158
# for the filter language and the file language, which might differ due to filter mapping)
9159
$evalCode="exists \$${moduleName}::{importFilter}";
9160
$flags{ifilters}{lc($optionHash->{import})}=$flags{ifilters}{$filterLang}=join('::', $moduleName, 'importFilter()') if ref($safeObject) ? $safeObject->reval($evalCode) : eval $evalCode;
9161
};
9162
9163
# check success
9164
$parser->_semerr("Could not load $optionHash->{import} import filter module: $@."), return undef if $@;
9165
}
9166
9167
# now, set a functional filter, if possible
9168
$optionHash->{ifilter}=$flags{ifilters}{$filterLang}
9169
if exists $flags{ifilters}{$filterLang} and defined $flags{ifilters}{$filterLang};
9170
}
9171
9172
# flag success
9173
1;
9174
}
9175
9176
# perform paragraph filter calls
9177
sub _pfilterCall
9178
{
9179
# get and check parameters
9180
my ($parser, $filters, $pstream, $lineNr)=@_;
9181
confess "[BUG] Missing parser parameter.\n" unless $parser;
9182
confess "[BUG] Missing filter list.\n" unless $filters;
9183
confess "[BUG] Filter list is no array reference.\n" unless ref($filters) eq 'ARRAY';
9184
confess "[BUG] Missing paragraph stream.\n" unless $pstream;
9185
confess "[BUG] Paragraph stream is no array reference.\n" unless ref($pstream) eq 'ARRAY';
9186
confess "[BUG] Missing line number.\n" unless $lineNr;
9187
9188
9189
# declare and init variables
9190
my ($streamRef, %tableCounters);
9191
$retranslationBuffer='';
9192
9193
# build retranslator, if necessary
9194
unless ($retranslator)
9195
{
9196
# scopy
9197
my ($verbatimFlag)=(0);
9198
9199
# the retranslator is a backend object
9200
$retranslator=new PerlPoint::Backend(
9201
name => 'retranslator',
9202
display => DISPLAY_NOINFO+DISPLAY_NOWARN,
9203
trace => TRACE_NOTHING,
9204
);
9205
9206
# various callbacks perform the retranslation
9207
$retranslator->register(DIRECTIVE_SIMPLE, sub
9208
{
9209
# get parameters
9210
my ($opcode, $mode, @contents)=@_;
9211
9212
# add contents to the source text collection,
9213
# double backslashes (if they are here, they were guarded originally),
9214
# and restore ">" characters as if they were guarded
9215
(my $text=join('', @contents));
9216
$text=~s/([\\>])/\\$1/g unless $verbatimFlag;
9217
$retranslationBuffer.=$text;
9218
}
9219
);
9220
9221
$retranslator->register(DIRECTIVE_HEADLINE, sub
9222
{
9223
# get parameters
9224
my ($opcode, $mode, $level)=@_;
9225
9226
# add preceeding "=" characters
9227
$retranslationBuffer.=('=' x $level) if $mode==DIRECTIVE_START;
9228
}
9229
);
9230
9231
$retranslator->register(DIRECTIVE_VERBATIM, sub
9232
{
9233
# get parameters
9234
my ($opcode, $mode)=@_;
9235
9236
# cover contents
9237
$verbatimFlag=1, $retranslationBuffer.="<
9238
$verbatimFlag=0, $retranslationBuffer.="EOE\n" if $mode==DIRECTIVE_COMPLETE;
9239
}
9240
);
9241
9242
my $handleListPoint=sub
9243
{
9244
# get parameters
9245
my ($opcode, $mode, @data)=@_;
9246
9247
# act mode dependend
9248
if ($mode==DIRECTIVE_START)
9249
{$retranslationBuffer.=$opcode==DIRECTIVE_UPOINT ? '* ' : $opcode==DIRECTIVE_OPOINT ? '# ' : ':';}
9250
else
9251
{$retranslationBuffer.="\n\n"}
9252
};
9253
9254
my $handleDListPointItem=sub
9255
{
9256
# get parameters
9257
my ($opcode, $mode, @data)=@_;
9258
9259
# complete the item part if necessary
9260
$retranslationBuffer.=': ' if $mode==DIRECTIVE_COMPLETE;
9261
};
9262
9263
my $handleListShift=sub
9264
{
9265
# get parameters
9266
my ($opcode, $mode, $offset)=@_;
9267
9268
# anything to do?
9269
$retranslationBuffer.=join('',
9270
$opcode==DIRECTIVE_LIST_RSHIFT ? '>' : '<',
9271
"$offset\n\n",
9272
) if $mode==DIRECTIVE_START;
9273
};
9274
9275
$retranslator->register($_, $handleListPoint) foreach (DIRECTIVE_UPOINT, DIRECTIVE_OPOINT, DIRECTIVE_DPOINT);
9276
$retranslator->register($_, $handleListShift) foreach (DIRECTIVE_LIST_LSHIFT, DIRECTIVE_LIST_RSHIFT);
9277
$retranslator->register(DIRECTIVE_DPOINT_ITEM, $handleDListPointItem);
9278
9279
$retranslator->register(DIRECTIVE_TAG, sub
9280
{
9281
# get parameters
9282
my ($opcode, $mode, $tag, $settings, $bodyHint)=@_;
9283
9284
# table tags need special care, is it one?
9285
unless ($tag=~/^TABLE/)
9286
{
9287
# it can happen that perl complains about an undefined value here
9288
# even if no such value is to be find in debugging
9289
local($^W)=0;
9290
9291
# act mode dependend
9292
$retranslationBuffer.=$mode==DIRECTIVE_START ? join('', "\\$tag", (defined $settings and %$settings and grep(!/^__/, keys %$settings)) ? join('', '{', join(' ', map {qq($_="$settings->{$_}")} grep(!/^__/, keys %$settings)), '}') : (), ((defined $bodyHint and $bodyHint) ? '<' : ())) : ((defined $bodyHint and $bodyHint) ? '>' : ());
9293
}
9294
else
9295
{
9296
# TABLE declared by paragraph?
9297
if ($tag eq 'TABLE' and exists $settings->{__paragraph__})
9298
{
9299
# translate TABLE into paragraph start or completion
9300
$retranslationBuffer.=$mode==DIRECTIVE_START ? join('', '@', $settings->{separator}, "\n") : '';
9301
# init counters, store separators
9302
@tableCounters{qw(row col rowsep colsep)}=(0, 0, "\n", " $settings->{separator} ");
9303
}
9304
# TABLE declared by tags?
9305
elsif ($tag eq 'TABLE')
9306
{
9307
# translate TABLE into TABLE and END_TABLE
9308
$retranslationBuffer.=$mode==DIRECTIVE_START ? join('', '\TABLE{', join(' ', map {qq($_="$settings->{$_}")} grep(!/^__/, keys %$settings)), '}', $settings->{rowseparator} eq '\\\n' ? "\n" : '') : join('', $settings->{rowseparator} eq '\\\n' ? "\n" : '', '\END_TABLE');
9309
# init counters, store separators
9310
@tableCounters{qw(row col rowsep colsep)}=(0, 0, $settings->{rowseparator} eq '\\\n' ? "\n" : $settings->{rowseparator}, $settings->{separator} eq '\\\n' ? "\n" : " $settings->{separator} ");
9311
}
9312
# TABLE_ROW?
9313
elsif ($tag eq 'TABLE_ROW')
9314
{
9315
# we only need to act at startup
9316
if ($mode==DIRECTIVE_START)
9317
{
9318
# write a row separator if there was a row before
9319
$retranslationBuffer.=$tableCounters{rowsep} if $tableCounters{row};
9320
# update row counter, reset column counter
9321
$tableCounters{row}++;
9322
$tableCounters{col}=0;
9323
}
9324
}
9325
# TABLE_HL or TABLE_COL?
9326
elsif ($tag=~/TABLE_(HL|COL)/)
9327
{
9328
# we only need to act at startup
9329
if ($mode==DIRECTIVE_START)
9330
{
9331
# write a column separator if there was a column before
9332
$retranslationBuffer.=$tableCounters{colsep} if $tableCounters{col};
9333
# update row counter
9334
$tableCounters{col}++;
9335
}
9336
}
9337
}
9338
}
9339
);
9340
}
9341
9342
# embed paragraph stream into a structure looking like a complete stream
9343
@{$streamRef}[
9344
STREAM_IDENT,
9345
STREAM_TOKENS,
9346
STREAM_HEADLINES,
9347
]=(
9348
'__PerlPoint_stream__', # stream identifier;
9349
$pstream, # base stream: paragraph stream;
9350
[], # headline stream (dummy);
9351
);
9352
9353
# retranslate paragraph
9354
$retranslator->run($streamRef);
9355
9356
# init paragraph text
9357
# $retranslationBuffer=join('', @{$pstream}[1..($#{$pstream}-1)]);
9358
9359
# warn "BUFFER: $retranslationBuffer\n";
9360
9361
foreach my $perl (@$filters)
9362
{
9363
# we provide the paragraph text simply - for a general solution, we need to use an object
9364
# of a handy subclass of PerlPoint::Backend (still to be written)
9365
{
9366
no strict 'refs';
9367
${join('::', ref($safeObject) ? $safeObject->root : 'main', '_pfilterText')}=$retranslationBuffer;
9368
${join('::', ref($safeObject) ? $safeObject->root : 'main', '_pfilterType')}=$paragraphTypeStrings{$pstream->[0][1]};
9369
}
9370
9371
# inform user
9372
warn qq([Trace] $sourceFile, line $lineNr: Running paragraph filter "$perl".\n) if $flags{trace} & TRACE_ACTIVE;
9373
9374
# call the filter
9375
$retranslationBuffer=ref($safeObject) ? $safeObject->reval($perl) : eval(join(' ', '{package main; no strict;', $perl, '}'));
9376
9377
# check result
9378
if ($@)
9379
{
9380
# inform user, if necessary
9381
_semerr($parser, qq($sourceFile, line $lineNr: paragraph filter "$perl" could not be evaluated: $@.));
9382
9383
# stop processing, flag error
9384
return undef;
9385
}
9386
}
9387
9388
# success: reply result (embed it into empty lines to avoid paragraph mismatch)
9389
defined $retranslationBuffer ? [("\n") x 2, split(/(\n)/, $retranslationBuffer), ("\n") x 2] : '';
9390
}
9391
9392
=pod
9393
9394
=head2 anchors()
9395
9396
A class method that supplied all anchors collected by the parser.
9397
9398
Example:
9399
9400
my $anchors=PerlPoint::Parser::anchors;
9401
9402
=cut
9403
sub anchors
9404
{$anchors;}
9405
9406
1;
9407
9408
9409
# declare a helper package used for token "delay" after bodyless macros
9410
# (implemented the oo way to determine the data)
9411
package PerlPoint::Parser::DelayedToken;
9412
9413
# even this tiny package needs modules!
9414
use Carp;
9415
9416
# make an object holding the token name and its value
9417
sub new
9418
{
9419
# get parameter
9420
my ($class, $token, $value)=@_;
9421
9422
# check parameters
9423
confess "[BUG] Missing class name.\n" unless $class;
9424
confess "[BUG] Missing token parameter.\n" unless $token;
9425
confess "[BUG] Missing token value parameter.\n" unless defined $value;
9426
9427
# build and reply object
9428
bless([$token, $value], $class);
9429
}
9430
9431
# reply token
9432
sub token {$_[0]->[0];}
9433
9434
# reply value
9435
sub value {$_[0]->[1];}
9436
9437
1;
9438
9439
9440
# = POD TRAILER SECTION =================================================================
9441
9442
=pod
9443
9444
=head1 EXAMPLE
9445
9446
The following code shows a minimal but complete parser.
9447
9448
# pragmata
9449
use strict;
9450
9451
# load modules
9452
use PerlPoint::Parser;
9453
9454
# declare variables
9455
my (@streamData);
9456
9457
# build parser
9458
my ($parser)=new PerlPoint::Parser;
9459
# and call it
9460
$parser->run(
9461
stream => \@streamData,
9462
files => \@ARGV,
9463
);
9464
9465
=head1 NOTES
9466
9467
=head2 Converter namespace
9468
9469
It is suggested to B operating in namespace B. In order to emulate
9470
the behaviour of the B module by C in case a user wishes to get
9471
full Perl access for active contents, active contents needs to be executed in
9472
this namespace. Safe does not allow to change this, so the documented default
9473
for "saved" and "not saved" active contents I to be C. This means
9474
that both the parser and active contents will pollute C. Prevent from being
9475
effected by choosing a different converter namespace. The B
9476
hyrarchy is reserved for this purpose. The recommended namespace is
9477
C>, e.g. C.
9478
9479
=head2 Format
9480
9481
The PerlPoint format was initially designed by I,
9482
who wrote an HTML slide generator for it, too.
9483
9484
I added a number of additional, useful and interesting
9485
features to the original implementation. At a certain point, we
9486
decided to redesign the tool to make it a base for slide generation
9487
not only into HTML but into various document description languages.
9488
9489
The PerlPoint format implemented by this parser version is slightly
9490
different from the original design. Presentations written for Perl
9491
Point 1.0 will I pass the parser but can simply be converted
9492
into the new format. We designed the new format as a team of
9493
I, I and me.
9494
9495
=head2 Storable updates
9496
9497
From version 0.24 on the Storable module is a prerequisite of the
9498
parser package because Storable is used to store and retrieve cache
9499
data in files. If you update your Storable installation it I
9500
happen that its internal format changes and therefore stored cache
9501
data becomes unreadable. To avoid this, the parser automatically
9502
rebuilds existing caches in case of Storable updates.
9503
9504
=head1 FILES
9505
9506
If Is are used, the parser writes cache files where the initial
9507
sources are stored. They are named ..ppcache.
9508
9509
=head1 SEE ALSO
9510
9511
=over 4
9512
9513
=item PerlPoint::Backend
9514
9515
A frame class to write backends basing on the I.
9516
9517
=item PerlPoint::Constants
9518
9519
Constants used by parser functions and in the I.
9520
9521
=item PerlPoint::Tags
9522
9523
Tag declaration base class.
9524
9525
=item pp2sdf
9526
9527
A reference implementation of a PerlPoint converter, distributed with the parser package.
9528
9529
=item pp2html
9530
9531
The inital PerlPoint tool designed and provided by Tom Christiansen. A new translator
9532
by I using B.
9533
9534
=back
9535
9536
9537
=head1 SUPPORT
9538
9539
A PerlPoint mailing list is set up to discuss usage, ideas,
9540
bugs, suggestions and translator development. To subscribe,
9541
please send an empty message to perlpoint-subscribe@perl.org.
9542
9543
If you prefer, you can contact me via perl@jochen-stenzel.de
9544
as well.
9545
9546
9547
=head1 AUTHOR
9548
9549
Copyright (c) Jochen Stenzel (perl@jochen-stenzel.de), 1999-2001.
9550
All rights reserved.
9551
9552
This module is free software, you can redistribute it and/or modify it
9553
under the terms of the Artistic License distributed with Perl version
9554
5.003 or (at your option) any later version. Please refer to the
9555
Artistic License that came with your Perl distribution for more
9556
details.
9557
9558
The Artistic License should have been included in your distribution of
9559
Perl. It resides in the file named "Artistic" at the top-level of the
9560
Perl source tree (where Perl was downloaded/unpacked - ask your
9561
system administrator if you dont know where this is). Alternatively,
9562
the current version of the Artistic License distributed with Perl can
9563
be viewed on-line on the World-Wide Web (WWW) from the following URL:
9564
http://www.perl.com/perl/misc/Artistic.html.
9565
9566
B is built using B a way that users
9567
have I to explicitly install B themselves. According
9568
to the copyright note of B I have to mention the following:
9569
9570
"The Parse::Yapp module and its related modules and shell
9571
scripts are copyright (c) 1998-1999 Francois Desarmenien,
9572
France. All rights reserved.
9573
9574
You may use and distribute them under the terms of either
9575
the GNU General Public License or the Artistic License, as
9576
specified in the Perl README file."
9577
9578
9579
=head1 DISCLAIMER
9580
9581
This software is distributed in the hope that it will be useful, but
9582
is provided "AS IS" WITHOUT WARRANTY OF ANY KIND, either expressed or
9583
implied, INCLUDING, without limitation, the implied warranties of
9584
MERCHANTABILITY and FITNESS FOR A PARTICULAR PURPOSE.
9585
9586
The ENTIRE RISK as to the quality and performance of the software
9587
IS WITH YOU (the holder of the software). Should the software prove
9588
defective, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR
9589
CORRECTION.
9590
9591
IN NO EVENT WILL ANY COPYRIGHT HOLDER OR ANY OTHER PARTY WHO MAY CREATE,
9592
MODIFY, OR DISTRIBUTE THE SOFTWARE BE LIABLE OR RESPONSIBLE TO YOU OR TO
9593
ANY OTHER ENTITY FOR ANY KIND OF DAMAGES (no matter how awful - not even
9594
if they arise from known or unknown flaws in the software).
9595
9596
Please refer to the Artistic License that came with your Perl
9597
distribution for more details.
9598
9599
=cut
9600
9601
1;