File Coverage

blib/lib/Text/MacroScript.pm
Criterion Covered Total %
statement 520 539 96.4
branch 151 162 93.2
condition 23 23 100.0
subroutine 92 92 100.0
pod 14 18 77.7
total 800 834 95.9


line stmt bran cond sub pod time code
1             package Text::MacroScript;
2              
3             require v5.10;
4              
5 41     41   40119 use strict;
  41         130  
  41         1219  
6 41     41   258 use warnings;
  41         80  
  41         1245  
7              
8 41     41   246 use Carp qw( carp croak );
  41         120  
  41         3413  
9             our @CARP_NOT = ( __PACKAGE__ );
10 41     41   32182 use Path::Tiny;
  41         456199  
  41         2442  
11              
12 41     41   355 use vars qw( $VERSION $NAME_RE $COMMENT );
  41         124  
  41         4571  
13             $VERSION = '2.12';
14              
15             BEGIN {
16 41     41   237 $NAME_RE = qr/ [^\s\[\|\]\#]+ /x; # name cannot contain blanks [ | ] #
17 41         1011 $COMMENT = "%%"; # comment macro
18             };
19              
20             #------------------------------------------------------------------------------
21             # object to hold current input stack for nested structs
22 41     41   20814 use enum qw( CTX_ARGS=1 CTX_TEXT );
  41         47952  
  41         271  
23             {
24             package # hide this from CPAN
25             Text::MacroScript::Context;
26            
27             use Object::Tiny::RW
28 41         289 'type', # type of struct to match, one of CTX_...
29             'start_line_nr', # line number where struct started
30             'commit_func', # function to call when struct ends
31             # passed $output_ref argument
32              
33             # collecting parameters
34             'args', # current collected arguments
35             'open_parens', # number of open parenthesis
36            
37             # end text collection
38             'end_text_re', # regexp to end _parse_collect_text()
39             'eat_blanks', # eat blanks after end of []
40 41     41   33628 ;
  41         13567  
41            
42             sub new {
43 239     239   2542 my($class, $type, $start_line_nr, $commit_func, $end_text_re, $eat_blanks) = @_;
44              
45 239         961 my $self = $class->SUPER::new(
46             type => $type,
47             start_line_nr => $start_line_nr,
48             commit_func => $commit_func,
49            
50             args => [],
51             open_parens => 1, # init at 1, as first '[' is already matched
52            
53             end_text_re => $end_text_re,
54             eat_blanks => $eat_blanks,
55             );
56 239         2016 return $self;
57             }
58             }
59              
60             #------------------------------------------------------------------------------
61             # main object
62             use Object::Tiny::RW
63 41         313 'parse_func', # current parsing function
64            
65             'file', # current input file name for error messages
66             'line_nr', # current line number
67            
68             'context', # stack of Text::MacroScript::Context, empty if none
69             'actions', # hash of text -> function to call if matched
70             'variables', # hash of variable name -> current value
71             'macros', # hash of scripts/macros name -> body
72             'is_script', # TRUE for script, false for macro
73            
74             'args', # list of arguments to script
75             'regexp', # big regexp computed each time text_action changes
76              
77             'embedded', # true if parsing embedded text
78             'in_embedded', # true if inside embedded delimiters
79             'opendelim', # open delimiter for embedded processing
80             'closedelim', # close delimiter for embedded processing
81             'comment', # True to create the %%[] comment macro
82 41     41   23295 ;
  41         101  
83              
84             #------------------------------------------------------------------------------
85             # new
86             sub new {
87 154     154 1 659810 my($class, %opts) = @_;
88            
89 154         1445 my $self = $class->SUPER::new(
90             parse_func => \&_parse_execute,
91             file => '-',
92             line_nr => 1,
93            
94             context => [],
95             actions => {},
96             variables => {},
97             macros => {},
98             is_script => {},
99              
100             args => [],
101             regexp => qr//,
102            
103             embedded => 0,
104             in_embedded => 0,
105             opendelim => '<:',
106             closedelim => ':>',
107             comment => 0,
108             );
109 154         1996 $self->_update_regexp;
110            
111             # parse options: -comment
112 154 100       1802 if ($opts{-comment}) {
113 3         10 $self->_define_standard_comment;
114 3         145 $self->comment(1);
115             }
116 154         290 delete $opts{-comment};
117            
118             # parse options: -embedded
119 154 100 100     986 if ($opts{-embedded} || defined($opts{-opendelim})) {
120 13         231 $self->embedded(1);
121 13   100     359 $self->opendelim($opts{-opendelim} // "<:");
122 13   100     314 $self->closedelim($opts{-closedelim} // $opts{-opendelim} // ":>");
      100        
123             }
124 154         499 delete @opts{qw( -embedded -opendelim -closedelim)};
125              
126             # parse options: -variable
127 154 100       360 if ($opts{-variable}) {
128 6         11 foreach (@{$opts{-variable}}) {
  6         17  
129 12         62 my($name, $value) = @$_;
130 12         77 $self->define_variable($name, $value);
131             }
132             }
133 154         283 delete $opts{-variable};
134            
135             # parse options: -macro
136 154 100       346 if ($opts{-macro}) {
137 9         41 foreach (@{$opts{-macro}}) {
  9         28  
138 19         280 my($name, $value) = @$_;
139 19         59 $self->define_macro($name, $value);
140             }
141             }
142 154         500 delete $opts{-macro};
143            
144             # parse options: -script
145 154 100       348 if ($opts{-script}) {
146 10         23 foreach (@{$opts{-script}}) {
  10         25  
147 19         323 my($name, $value) = @$_;
148 19         52 $self->define_script($name, $value);
149             }
150             }
151 154         497 delete $opts{-script};
152            
153             # parse options: -file
154 154 100       469 if ($opts{-file}) {
155 2         9 foreach my $file (@{$opts{-file}}) {
  2         15  
156 3         15 $self->load_file($file);
157             }
158             }
159 153         254 delete $opts{-file};
160            
161             # check for invalid options
162 153 100       603 croak "Invalid options ".join(",", sort keys %opts) if %opts;
163            
164 152         479 return $self;
165             }
166              
167             #------------------------------------------------------------------------------
168             # error
169             sub _error {
170 56     56   449 my($self, $message) = @_;
171 56         140 chomp($message);
172 56         1006 die "Error at file ", $self->file, " line ", $self->line_nr, ": ", $message, "\n";
173             }
174              
175             #------------------------------------------------------------------------------
176             # contexts
177             sub _push_context {
178 239     239   540 my($self, $type, $commit_func, $end_text_re, $eat_blanks) = @_;
179            
180 239         4313 my $previous_parse = $self->parse_func;
181             my $context = Text::MacroScript::Context->new($type, $self->line_nr,
182             sub {
183 225     225   1378 my($output_ref) = @_;
184            
185             # pop context
186 225         546 my $context = $self->_last_context_assert($type);
187 225         395 my @args = @{$context->args};
  225         4446  
188 225         1795 $self->_pop_context;
189            
190             # reset parser - it will be used when defining the variable
191 225         4626 $self->parse_func( $previous_parse );
192            
193             # call commit function with input arguments
194 225         1732 $commit_func->($output_ref, @args);
195             },
196 239         4970 $end_text_re,
197             $eat_blanks);
198 239         444 push @{$self->context}, $context;
  239         4155  
199             }
200              
201             sub _last_context {
202 766     766   1242 my($self) = @_;
203 766 50       998 $self->_error("Unbalanced close structure") unless @{$self->context};
  766         12464  
204 766         17039 return $self->context->[-1];
205             }
206              
207             sub _last_context_assert {
208 527     527   917 my($self, $type) = @_;
209 527         1026 my $context = $self->_last_context();
210 527 50       10479 $self->_error("Unbalanced close structure") unless $type == $context->type;
211 527         3410 return $context;
212             }
213              
214             sub _pop_context {
215 225     225   383 my($self) = @_;
216 225         573 $self->_last_context();
217 225         1126 pop @{$self->context};
  225         3475  
218             }
219              
220             #------------------------------------------------------------------------------
221             # Destroy object, syntax error if input not complete - e.g. missing close struct
222             DESTROY {
223 151     151   92975 my($self) = @_;
224 151 100       312 if (@{$self->context}) {
  151         3714  
225 14         119 my $context = $self->_last_context;
226 14 50       314 $self->line_nr( $context ? $context->start_line_nr : "unknown" );
227 14         346 $self->_error("Unbalanced open structure at end of file");
228             }
229             }
230              
231             #------------------------------------------------------------------------------
232             # create the parsing regexp
233             sub _update_regexp {
234 486     486   956 my($self) = @_;
235            
236 41     41   73946 use re 'eval';
  41         102  
  41         174793  
237              
238 486         859 my $regexp = '(?';
239            
240             # escape chars
241 486         2802 $regexp .= '|'.qr/ (?> \\ ( [\#\%] ) (?{ \&_match_escape }) ) /mx;
  0         0  
242            
243             # escape newline
244 486         2905 $regexp .= '|'.qr/ (?> \\ \n (?{ \&_match_escape_newline }) ) /mx;
  0         0  
245            
246             # %DEFINE_VARIABLE
247             $regexp .= '|'.qr/ (?> ^ [\t ]* \% DEFINE_VARIABLE
248 486         2351 (?{ \&_match_define_variable }) ) /mx;
  0         0  
249              
250             # %UNDEFINE_ALL_VARIABLE
251             $regexp .= '|'.qr/ (?> ^ [\t ]* \% UNDEFINE_ALL_VARIABLE \s*
252 486         2192 (?{ \&_match_undefine_all_variable }) ) /mx;
  0         0  
253              
254             # %UNDEFINE_VARIABLE
255             $regexp .= '|'.qr/ (?> ^ [\t ]* \% UNDEFINE_VARIABLE
256 486         2159 (?{ \&_match_undefine_variable }) ) /mx;
  0         0  
257              
258             # %DEFINE_SCRIPT
259             $regexp .= '|'.qr/ (?> ^ [\t ]* \% DEFINE_SCRIPT
260 486         2402 (?{ \&_match_define_script }) ) /mx;
  0         0  
261            
262             # %UNDEFINE_ALL_SCRIPT
263             $regexp .= '|'.qr/ (?> ^ [\t ]* \% UNDEFINE_ALL_SCRIPT \s*
264 486         2044 (?{ \&_match_undefine_all_script }) ) /mx;
  0         0  
265              
266             # %UNDEFINE_SCRIPT
267             $regexp .= '|'.qr/ (?> ^ [\t ]* \% UNDEFINE_SCRIPT
268 486         2090 (?{ \&_match_undefine_macro_script }) ) /mx;
  0         0  
269              
270             # %DEFINE
271 486         1998 $regexp .= '|'.qr/ (?> ^ [\t ]* \% DEFINE (?{ \&_match_define_macro }) ) /mx;
  0         0  
272            
273             # %UNDEFINE_ALL
274             $regexp .= '|'.qr/ (?> ^ [\t ]* \% UNDEFINE_ALL \s*
275 486         1868 (?{ \&_match_undefine_all_macro }) ) /mx;
  0         0  
276              
277             # %UNDEFINE
278 486         2783 $regexp .= '|'.qr/ (?> ^ [\t ]* \% UNDEFINE (?{ \&_match_undefine_macro_script }) ) /mx;
  0         0  
279              
280             # %CASE
281 486         1967 $regexp .= '|'.qr/ (?> ^ [\t ]* \% CASE (?{ \&_match_case }) ) /mx;
  0         0  
282              
283             # %LOAD
284 486         1802 $regexp .= '|'.qr/ (?> ^ [\t ]* \% LOAD (?{ \&_match_load }) ) /mx;
  0         0  
285              
286             # %INCLUDE
287 486         2289 $regexp .= '|'.qr/ (?> ^ [\t ]* \% INCLUDE (?{ \&_match_include }) ) /mx;
  0         0  
288              
289             # %REQUIRE
290 486         2029 $regexp .= '|'.qr/ (?> ^ [\t ]* \% REQUIRE (?{ \&_match_require }) ) /mx;
  0         0  
291              
292             # concatenate operator
293 486         1813 $regexp .= '|'.qr/ (?> [\t ]* \# \# [\t ]* (?{ \&_match_concat }) ) /mx;
  0         0  
294            
295             # arguments to scripts
296 486         1857 $regexp .= '|'.qr/ (?> \# ( \d+ ) (?{ \&_match_expand_arg }) ) /mx;
  0         0  
297            
298            
299             # user actions reverse sorted by length, so that longest match is found
300 486         10554 my $actions = $self->actions;
301 486         4422 for my $key (sort {length $b <=> length $a} keys %$actions) {
  2147         3552  
302 1342         22392 $regexp .= '|'.qr/ (?> \Q$key\E (?{ \&_match_action }) ) /mx;
  0         0  
303             }
304            
305 486         1087 $regexp .= ')';
306              
307 486         173506 $regexp = qr/$regexp/;
308            
309 486         12584 $self->regexp($regexp);
310             }
311              
312             #------------------------------------------------------------------------------
313             # match functions: called with matched text and following text; return new
314             # following text
315             sub _match_escape {
316 10     10   55 my($self, $output_ref, $match, $input) = @_;
317 10         28 $$output_ref .= $1; # special char is no longer parsed
318 10         29 return $input;
319             }
320              
321             sub _match_escape_newline {
322 5     5   30 my($self, $output_ref, $match, $input) = @_;
323 5         15 $$output_ref .= ' ';
324 5         13 return $input;
325             }
326              
327             sub _match_concat {
328 3     3   13 my($self, $output_ref, $match, $input) = @_;
329 3         9 return $input;
330             }
331              
332             sub _match_define_variable {
333 41     41   161 my($self, $output_ref, $match, $input) = @_;
334            
335 41 100       655 $input =~ / [\t ]* ( $NAME_RE ) [\t ]* \[ /x
336             or $self->_error("Expected NAME [EXPR]");
337 38         133 my $name = $1;
338 38         81 $input = $';
339            
340             # create a new context
341             $self->_push_context(CTX_ARGS,
342             sub {
343 37     37   98 my($rt_output_ref, @args) = @_;
344 37 100       103 @args == 1 or $self->_error("Only one argument expected");
345 36         113 $self->define_variable($name, $args[0]);
346             },
347             undef,
348 38         244 1);
349            
350             # change parser
351 38         892 $self->parse_func( \&_parse_args );
352            
353 38         336 return $input;
354             }
355              
356             sub _match_undefine {
357 24     24   57 my($self, $input_ref) = @_;
358            
359 24 100       351 $$input_ref =~ / [\t ]* ( $NAME_RE ) \s* /x
360             or $self->_error("Expected NAME");
361 18         52 my $name = $1;
362 18         36 $$input_ref = $';
363            
364 18         58 return $name;
365             }
366              
367             sub _match_undefine_variable {
368 8     8   35 my($self, $output_ref, $match, $input) = @_;
369              
370 8         28 my $name = $self->_match_undefine( \$input );
371 6         22 $self->undefine_variable($name);
372              
373 6         61 return $input;
374             }
375              
376             sub _match_undefine_all_variable {
377 3     3   16 my($self, $output_ref, $match, $input) = @_;
378              
379 3         13 $self->undefine_all_variable;
380              
381 3         40 return $input;
382             }
383              
384             sub _match_define_macro_script {
385 92     92   229 my($self, $output_ref, $match, $input, $is_script) = @_;
386            
387             # collect name
388 92 100       1135 $input =~ / [\t ]* ( $NAME_RE ) [\t ]* /x
389             or $self->_error("Expected NAME");
390 87         260 my $name = $1;
391 87         218 $input = $';
392            
393             # definition in the same line?
394 87 100       327 if ($input =~ /^ \[ /x) {
395 60         154 $input = $';
396            
397             # create a new context
398             $self->_push_context(CTX_ARGS,
399             sub {
400 58     58   162 my($rt_output_ref, @args) = @_;
401 58 50       172 @args == 1 or $self->_error("Only one argument expected");
402 58         183 $self->_define_macro_script($name, $args[0], $is_script);
403             },
404             undef,
405 60         399 1);
406            
407             # change parser
408 60         1347 $self->parse_func( \&_parse_args );
409             }
410             else {
411 27         91 $input =~ s/^\s+//; # eat newline
412              
413             # collect text up to %END_DEFINE
414             $self->_push_context(CTX_TEXT,
415             sub {
416 17     17   52 my($rt_output_ref, $text) = @_;
417 17         59 $self->_define_macro_script($name, $text, $is_script);
418             },
419 27         277 qr/ ^ [\t ]* \% END_DEFINE \s* /mx,
420             0);
421            
422             # change parser
423 27         591 $self->parse_func( \&_parse_collect_text );
424             }
425              
426 87         770 return $input;
427             }
428              
429             sub _match_define_macro {
430 55     55   274 my($self, $output_ref, $match, $input) = @_;
431 55         193 return $self->_match_define_macro_script($output_ref, $match, $input, 0);
432             }
433              
434             sub _match_case {
435 14     14   55 my($self, $output_ref, $match, $input) = @_;
436            
437 14 100       83 $input =~ / [\t ]* \[ /x
438             or $self->_error("Expected [EXPR]");
439 12         25 $input = $';
440            
441             # create a new context
442             $self->_push_context(CTX_ARGS,
443             sub {
444 12     12   30 my($rt_output_ref, @args) = @_;
445 12 50       36 @args == 1 or $self->_error("Only one argument expected");
446            
447             # compute expression
448 12         35 my $case_arg = $self->_eval_expression($args[0]);
449            
450             # collect text up to next %CASE or %END_CASE
451             # or %CASE - in this case keep it in input, to be matched next
452             $self->_push_context(CTX_TEXT,
453             sub {
454 9         23 my($rt_output_ref, @args) = @_;
455 9 50       21 @args == 1 or $self->_error("Only one argument expected");
456            
457 9 100       25 if ($case_arg) {
458 5         11 my $body = $args[0];
459 5         11 $body =~ s/^\s+//; # eat newline
460 5         15 $$rt_output_ref .= $self->_expand($body);
461             }
462             },
463 10         78 qr/ ^ [\t ]* \% END_CASE \s* |
464             (?= ^ [\t ]* \% CASE ) /mx,
465             0);
466            
467 10         283 $self->parse_func( \&_parse_collect_text );
468             },
469             undef,
470 12         84 1);
471            
472             # change parser
473 12         289 $self->parse_func( \&_parse_args );
474            
475 12         88 return $input;
476             }
477              
478             sub _match_filename {
479 10     10   21 my($self, $input, $func) = @_;
480            
481 10 100       58 $input =~ / [\t ]* \[ /x
482             or $self->_error("Expected [FILENAME]");
483 8         19 $input = $';
484            
485             # create a new context
486             $self->_push_context(CTX_ARGS,
487             sub {
488 8     8   21 my($rt_output_ref, @args) = @_;
489 8 50       25 @args == 1 or $self->_error("Only one argument expected");
490 8         24 $self->$func($rt_output_ref, $args[0]);
491             },
492             undef,
493 8         51 1);
494            
495             # change parser
496 8         235 $self->parse_func( \&_parse_args );
497            
498 8         68 return $input;
499             }
500              
501             sub _match_load {
502 5     5   20 my($self, $output_ref, $match, $input) = @_;
503 5         16 return $self->_match_filename($input, \&_load_file);
504             }
505              
506             sub _match_include {
507 3     3   12 my($self, $output_ref, $match, $input) = @_;
508 3         11 return $self->_match_filename($input, \&_expand_file);
509             }
510              
511             sub _match_require {
512 2     2   9 my($self, $output_ref, $match, $input) = @_;
513             return $self->_match_filename($input,
514             sub {
515 2     2   5 my($self, $output_ref, $file) = @_;
516 2         9 $self->_eval_expression("require '$file'");
517 2         15 });
518             }
519              
520             sub _match_define_script {
521 37     37   197 my($self, $output_ref, $match, $input) = @_;
522 37         144 return $self->_match_define_macro_script($output_ref, $match, $input, 1);
523             }
524              
525             sub _match_undefine_macro_script {
526 16     16   79 my($self, $output_ref, $match, $input) = @_;
527            
528 16         64 my $name = $self->_match_undefine( \$input );
529 12         49 $self->_undefine_macro_script($name);
530              
531 12         130 return $input;
532             }
533              
534             sub _match_undefine_all_macro {
535 3     3   20 my($self, $output_ref, $match, $input) = @_;
536            
537 3         13 $self->undefine_all_macro;
538              
539 3         47 return $input;
540             }
541              
542             sub _match_undefine_all_script {
543 3     3   13 my($self, $output_ref, $match, $input) = @_;
544            
545 3         12 $self->undefine_all_script;
546              
547 3         25 return $input;
548             }
549              
550             sub _match_action {
551 354     354   1323 my($self, $output_ref, $match, $input) = @_;
552              
553 354 50       6246 my $func = $self->actions->{$match}
554             or $self->_error("No action found for '$match'");
555 354         2935 return $func->($self, $output_ref, $match, $input);
556             }
557              
558             sub _match_expand_arg {
559 111     111   425 my($self, $output_ref, $match, $input) = @_;
560            
561 111         231 my $arg = $1;
562 111 100       157 ($arg < scalar(@{ $self->args }))
  111         1922  
563             or $self->_error("Missing parameters");
564            
565 97         2149 $$output_ref .= $self->_expand( $self->args->[$arg] );
566 97         260 return $input;
567             }
568              
569             #------------------------------------------------------------------------------
570             # match engine - recurse to expand all macros, return expanded text
571             sub _expand {
572 1129     1129   3776 my($self, $input) = @_;
573 1129   100     2595 $input //= '';
574 1129         1811 my $output = '';
575              
576 1129         2431 while ($input ne '') {
577 1617         27812 $input = $self->parse_func->($self, \$output, $input);
578             }
579 1075         4690 return $output;
580             }
581              
582             # expand embedded text
583             sub _expand_embedded {
584 52     52   103 my($self, $input) = @_;
585 52   100     109 $input //= '';
586 52         82 my $output = '';
587              
588 52         111 while ($input ne '') {
589 123 100       2336 if ($self->in_embedded) {
590 58         1096 my $closedelim = $self->closedelim;
591 58 100       429 if ($input =~ /\Q$closedelim\E/) {
592 39         85 $input = $';
593 39         88 $output .= $self->_expand($`);
594 39         688 $self->in_embedded(0);
595             }
596             else {
597 19         51 $output .= $self->_expand($input);
598 19         52 $input = '';
599             }
600             }
601             else {
602 65         1304 my $opendelim = $self->opendelim;
603 65 100       526 if ($input =~ /\Q$opendelim\E/) {
604 39         99 $output .= $`;
605 39         82 $input = $';
606 39         606 $self->in_embedded(1);
607             }
608             else {
609 26         55 $output .= $input;
610 26         70 $input = '';
611             }
612             }
613             }
614 52         277 return $output;
615             }
616              
617             #------------------------------------------------------------------------------
618             # choose either _expand or _expand_embedded
619             sub expand {
620 556     556 1 28846 my($self, $text, $file, $line_nr) = @_;
621 556 100       3479 defined($file) and $self->file($file);
622 556 100       3301 $line_nr and $self->line_nr($line_nr);
623              
624 556 100       12221 if ($self->embedded) {
625 52         366 return $self->_expand_embedded($text);
626             }
627             else {
628 504         3876 return $self->_expand($text);
629             }
630             }
631              
632              
633              
634             # parse functions: execute macros
635             # input: text to parse and current output;
636             # output: remaining text to parse and total text to output
637             sub _parse_execute {
638 1315     1315   8400 my($self, $output_ref, $input) = @_;
639            
640 1315 100       195749 if ($input =~ / $self->{regexp} /x) {
641 673         1248 my $action = $^R;
642            
643             # execute action and set new input
644 673         2004 $$output_ref .= $`;
645 673         1790 $input = $self->$action($output_ref, $&, $');
646             }
647             else {
648 642         2009 $$output_ref .= $input; # remaining input
649 642         1291 $input = '';
650             }
651            
652 1277         9864 return $input;
653             }
654              
655             # parse functions: collect macro arguments
656             sub _parse_args {
657 215     215   1350 my($self, $output_ref, $input) = @_;
658            
659 215         519 my $context = $self->_last_context_assert(CTX_ARGS);
660 215   100     3511 while ( $context->open_parens > 0 && $input ne '' ) {
661 337 100       4303 if ( $input =~ /
662             (.*?)
663 5         24 (?| (?> \\ ( [\[\]\|] ) (?{ \&_parse_args_escape }) )
664 20         80 | (?> ( \[ ) (?{ \&_parse_args_open }) )
665 85         337 | (?> ( \| ) (?{ \&_parse_args_separator }) )
666 219         906 | (?> ( \] ) (?{ \&_parse_args_close }) )
667             )
668             /sx ) {
669 329         530 my $action = $^R;
670 329         774 $input = $'; # unparsed input
671 329         687 $action->($context);
672             }
673             else {
674 8 100       18 @{ $context->args } or push @{ $context->args }, '';
  3         63  
  8         159  
675 8         173 $context->args->[-1] .= $input;
676 8         188 $input = '';
677             }
678             }
679            
680             # check for end of parsing
681 215 100       4444 if ( $context->open_parens == 0 ) {
682 199         4149 $context->commit_func->($output_ref);
683 183 100       4411 $input =~ s/^\s+// if $context->eat_blanks;
684             }
685            
686 199         3404 return $input;
687             }
688              
689             sub _parse_args_escape {
690 5     5   16 my($context) = @_;
691 5 50       10 @{ $context->args } or push @{ $context->args }, '';
  5         108  
  5         85  
692 5         102 $context->args->[-1] .= $1.$2;
693             }
694              
695             sub _parse_args_open {
696 20     20   44 my($context) = @_;
697 20 100       39 @{ $context->args } or push @{ $context->args }, '';
  13         284  
  20         336  
698 20         435 $context->args->[-1] .= $1.$2;
699 20         439 $context->{open_parens}++;
700             }
701              
702             sub _parse_args_separator {
703 85     85   162 my($context) = @_;
704 85 100       118 @{ $context->args } or push @{ $context->args }, '';
  43         915  
  85         1443  
705 85 100       1756 if ( $context->open_parens == 1 ) {
706 74         1519 $context->args->[-1] .= $1;
707 74         458 push @{$context->args}, '';
  74         1182  
708             }
709             else {
710 11         233 $context->args->[-1] .= $1.$2;
711             }
712             }
713              
714             sub _parse_args_close {
715 219     219   411 my($context) = @_;
716 219 100       320 @{ $context->args } or push @{ $context->args }, '';
  135         3023  
  219         3860  
717 219 100       4537 if ( $context->open_parens == 1 ) {
718 199         4092 $context->args->[-1] .= $1;
719             }
720             else {
721 20         400 $context->args->[-1] .= $1.$2;
722             }
723 219         4791 $context->{open_parens}--;
724             }
725              
726             # Collect definition in text
727             sub _parse_collect_text {
728 87     87   557 my($self, $output_ref, $input) = @_;
729            
730 87         214 my $context = $self->_last_context_assert(CTX_TEXT);
731 87 100       136 @{ $context->args } or push @{ $context->args }, '';
  34         799  
  87         1362  
732 87         1772 my $end_text_re = $context->end_text_re;
733 87 100       752 if ($input =~ /$end_text_re/) {
734 26         455 $context->args->[-1] .= $`;
735 26         196 $input = $';
736 26         420 $context->commit_func->($output_ref);
737             }
738             else {
739 61         997 $context->args->[-1] .= $input;
740 61         371 $input = '';
741             }
742              
743 87         664 return $input;
744             }
745              
746             #------------------------------------------------------------------------------
747             # Define a new variable or overwrite an existing one
748             sub define_variable {
749 97     97 1 5290 my($self, $name, $value) = @_;
750              
751             # setup for a possible recursive _expand(), if definition refers to itself
752             # e.g. %DEFINE_VARIABLE X [#X + 1]
753 97   100     1761 $self->variables->{$name} //= ''; # default previous value
754 97         2421 $self->actions->{'#'.$name} = \&_expand_variable;
755 97         757 $self->_update_regexp;
756              
757 97         1545 $self->variables->{$name} = $self->_eval_expression($value, -ignore_errors);
758             }
759              
760             sub _expand_variable {
761 91     91   203 my($self, $output_ref, $match, $input) = @_;
762 91         189 my $name = substr($match, 1); # skip '#'
763 91         1490 $$output_ref .= $self->_expand( $self->variables->{$name} );
764 91         320 return $input;
765             };
766              
767             sub _eval_expression {
768 251     251   1388 my($self, $expression, $ignore_errors, @args) = @_;
769 251         393 my @save_args = @{ $self->args };
  251         4192  
770 251         5368 $self->args( \@args ); # set arguments for this call
771 251         1757 my @Param = @args; # to be used in script body
772            
773             # expand any macro calls in the expression
774 251         657 my $value = $self->_expand($expression);
775            
776 243         390 my %Var = %{ $self->variables }; # to be used in script body
  243         5005  
777              
778             # try to eval as a perl expression, drop value on failure
779             {
780 41     41   384 no warnings;
  41         113  
  41         106002  
  243         2057  
781 243         12936 my $eval_result = eval $value;
782 243 100       1110 if (! $@) {
    100          
783 224         465 $value = $eval_result;
784             }
785             elsif (! $ignore_errors) {
786 5         12 my $error = $@;
787 5         41 $error =~ s/ at \(eval.*//;
788 5         16 $error =~ s/^Execution of .* aborted due to compilation errors.\n//m;
789 5         25 $self->_error("Eval error: $error");
790             }
791             }
792              
793 238         524 %{ $self->variables } = %Var; # update any changed variables
  238         4360  
794            
795 238         5367 $self->args( \@save_args ); # restore previous level args
796            
797 238         3549 return $value;
798             }
799            
800             #------------------------------------------------------------------------------
801             # Undefine a variable; does nothing if variable does not exist
802             sub undefine_variable {
803 21     21 1 111 my($self, $name) = @_;
804            
805 21 100       423 if (exists $self->variables->{$name}) {
806 11         245 delete $self->variables->{$name};
807 11         246 delete $self->actions->{'#'.$name};
808 11         92 $self->_update_regexp;
809             }
810             }
811              
812             #------------------------------------------------------------------------------
813             # Define a new script/macro or overwrite an existing one
814             sub _define_macro_script {
815 184     184   424 my($self, $name, $body, $is_script) = @_;
816              
817 184         3771 $self->macros->{$name} = $body;
818 184         4101 $self->is_script->{$name} = $is_script;
819            
820 184         3834 $self->actions->{$name.'['} = \&_macro_script_collect_args;
821 184         4095 $self->actions->{$name} = \&_macro_script_no_args;
822 184         1200 $self->_update_regexp;
823             }
824              
825             sub _macro_script_collect_args {
826 84     84   194 my($self, $output_ref, $match, $input) = @_;
827              
828 84         251 my $name = substr($match, 0, length($match) - 1 ); # remove '['
829            
830             # create a new context
831             $self->_push_context(CTX_ARGS,
832             sub {
833 84     84   236 my($rt_output_ref, @args) = @_;
834 84         244 $self->_expand_macro_script($name, \@args, $rt_output_ref);
835             },
836             undef,
837 84         551 0);
838            
839             # change parser
840 84         1884 $self->parse_func( \&_parse_args );
841            
842 84         664 return $input;
843             }
844              
845             sub _macro_script_no_args {
846 179     179   404 my($self, $output_ref, $match, $input) = @_;
847              
848 179         267 my @args;
849 179         519 $self->_expand_macro_script($match, \@args, $output_ref);
850              
851 173         1207 return $input;
852             }
853              
854             sub _expand_macro_script {
855 263     263   531 my($self, $name, $args, $output_ref) = @_;
856            
857 263 100       4302 if ($self->is_script->{$name}) {
858 140         2962 $$output_ref .= $self->_eval_expression( $self->macros->{$name}, 0, @$args );
859             }
860             else {
861 123         791 my @save_args = @{ $self->args };
  123         2017  
862 123         2577 $self->args( $args ); # set arguments for this call
863              
864 123         2642 $$output_ref .= $self->_expand( $self->macros->{$name} );
865            
866 117         2406 $self->args( \@save_args ); # restore previous level args
867             }
868             }
869              
870             #------------------------------------------------------------------------------
871             # Undefine a script/macro; does nothing if script/macro does not exist
872             sub _undefine_macro_script {
873 31     31   78 my($self, $name) = @_;
874            
875 31 100       618 if (exists $self->macros->{$name}) {
876            
877 17         398 delete $self->macros->{$name};
878 17         343 delete $self->is_script->{$name};
879            
880 17         342 delete $self->actions->{$name.'['};
881 17         364 delete $self->actions->{$name};
882            
883 17         126 $self->_update_regexp;
884             }
885             }
886              
887             #------------------------------------------------------------------------------
888             # list_...
889             # List objects to STDOUT or return to array, option -nameonly to list only name
890             sub _list_line {
891 96     96   200 my($self, $define, $name, $body, $namesonly) = @_;
892 96         230 my $ret = "$define $name";
893 96 100       194 unless ($namesonly) {
894 48 100       157 if ($body =~ /\n/) {
895 8         26 chomp $body;
896 8         20 $ret .= "\n".$body."\n%END_DEFINE";
897             }
898             else {
899 40         115 $ret .= " [$body]";
900             }
901             }
902 96         158 $ret .= "\n";
903 96         220 $ret;
904             }
905              
906             sub _list_lines {
907 48     48   105 my($self, $define, $items, $namesonly, $output_ref) = @_;
908              
909 48         304 my @sorted_items = sort { $a->[0] cmp $b->[0] } @$items;
  48         180  
910 48         105 for (@sorted_items) {
911 96         310 my($name, $body) = @$_;
912 96         220 my $line = $self->_list_line($define, $name, $body, $namesonly);
913 96 100       204 if ($output_ref) {
914 48         111 push @$output_ref, $line;
915             }
916             else {
917 48         1339 print $line;
918             }
919             }
920             }
921              
922             sub list_variable {
923 16     16 1 14968 my($self, $namesonly) = @_;
924 16         31 my @lines;
925             my @items;
926            
927 16         21 while (my($name, $body) = each %{ $self->variables }) {
  48         902  
928 32         272 push @items, [$name, $body];
929             }
930            
931 16 100       174 $self->_list_lines("%DEFINE_VARIABLE", \@items, $namesonly,
932             wantarray ? \@lines : undef );
933 16 100       99 return @lines if wantarray;
934             }
935              
936             sub _list_macro_script {
937 32     32   84 my($self, $define, $is_script, $namesonly) = @_;
938 32         51 my @lines;
939             my @items;
940            
941 32         51 while (my($name, $body) = each %{ $self->macros }) {
  128         2834  
942 96 100       2038 push @items, [$name, $body] if !! $self->is_script->{$name} == !! $is_script;
943             }
944            
945 32 100       305 $self->_list_lines($define, \@items, $namesonly,
946             wantarray ? \@lines : undef );
947 32 100       189 return @lines if wantarray;
948             }
949              
950             sub list_macro {
951 16     16 1 16088 my($self, $namesonly) = @_;
952 16         52 $self->_list_macro_script("%DEFINE", 0, $namesonly);
953             }
954              
955             sub list_script {
956 16     16 1 14474 my($self, $namesonly) = @_;
957 16         45 $self->_list_macro_script("%DEFINE_SCRIPT", 1, $namesonly);
958             }
959              
960             #------------------------------------------------------------------------------
961             # load macro definitions from a file
962             sub _load_file {
963 10     10   22 my($self, $output_ref, $file) = @_;
964              
965             # Treat loaded files as if wrapped in delimiters (only affects embedded
966             # processing).
967 10         179 my $in_embedded = $self->in_embedded;
968 10         208 $self->in_embedded(1);
969              
970 10         89 $self->_expand_file(undef, $file); # never output
971              
972 7         167 $self->in_embedded($in_embedded);
973             }
974              
975             sub load_file {
976 6     6 1 2728 my($self, $file) = @_;
977 6         17 $self->_load_file(undef, $file);
978             }
979              
980             #------------------------------------------------------------------------------
981             # parses the given file with expand()
982             # Usage: $macro->expand_file($filename)
983             # In an array context will return the file, e.g.
984             # @expanded = $macro->expand_file($filename);
985             # In a void context will print to the current output filehandle
986             sub _expand_file {
987 36     36   76 my($self, $output_ref, $file) = @_;
988              
989             # let Path::Tiny handle '~' processing
990 36 100       326 $file or croak "Missing filename";
991 35         113 $file = path($file);
992            
993 35 100       1605 open(my $fh, $file) or $self->_error("Open '$file' failed: $!");
994 31         1333 my $line_nr;
995            
996             # define function to collect output
997             my $output;
998 31 100       154 if (! defined($output_ref)) {
    100          
    100          
    50          
999 8     6   39 $output = sub {};
1000             }
1001             elsif (ref($output_ref) eq 'SCALAR') {
1002 1     2   5 $output = sub { $$output_ref .= $_[0]; };
  2         19  
1003             }
1004             elsif (ref($output_ref) eq 'ARRAY') {
1005 17     35   77 $output = sub { push @$output_ref, $_[0]; };
  35         305  
1006             }
1007             elsif (ref($output_ref) eq 'GLOB') {
1008 5     2   31 $output = sub { print $_[0]; };
  2         75  
1009             }
1010             else {
1011 0         0 croak("invalid output_ref");
1012             }
1013            
1014             # read input
1015 31         756 while(defined(my $line = <$fh>)) {
1016 100         211 $line_nr++;
1017 100         285 $line = $self->expand($line, $file, $line_nr);
1018            
1019 95 100       502 $output->($line) if $line ne '';
1020             }
1021              
1022 26 50       459 close($fh) or croak "Close '$file' failed: $!";
1023             }
1024              
1025             sub expand_file {
1026 24     24 1 25461 my($self, $file) = @_;
1027 24         47 my @lines;
1028            
1029             # build output destination
1030 24 100       68 my $output_ref = wantarray ? \@lines : \*STDOUT;
1031 24         71 $self->_expand_file($output_ref, $file);
1032 18 100       128 return @lines if wantarray;
1033             }
1034              
1035             #------------------------------------------------------------------------------
1036             # Wrappers for script/macro
1037             sub define_macro {
1038 54     54 1 3260 my($self, $name, $body) = @_;
1039 54         160 $self->_define_macro_script($name, $body, 0);
1040             }
1041              
1042             sub define_script {
1043 55     55 1 3287 my($self, $name, $body) = @_;
1044 55         166 $self->_define_macro_script($name, $body, 1);
1045             }
1046              
1047             *undefine_macro = \&_undefine_macro_script;
1048             *undefine_script = \&_undefine_macro_script;
1049              
1050             #------------------------------------------------------------------------------
1051             # define the standard %% comment macro
1052             sub _define_standard_comment {
1053 5     5   27 my($self) = @_;
1054 5         13 $self->define_macro($COMMENT, '');
1055             }
1056              
1057             #------------------------------------------------------------------------------
1058             # Undefine all ...
1059             sub _undefine_all_macro_script {
1060 16     16   31 my($self, $is_script) = @_;
1061              
1062             # delete all keys first and update regexp at the end
1063             # do not call _undefine_macro_script to avoid recomputing the regexp
1064             # after each deleted macro
1065 16         33 for my $name (keys %{ $self->macros }) {
  16         381  
1066 51 100       1100 if ( !! $is_script == !! $self->is_script->{$name} ) {
1067 39         806 delete $self->macros->{$name};
1068 39         792 delete $self->is_script->{$name};
1069 39         763 delete $self->actions->{$name.'['};
1070 39         813 delete $self->actions->{$name};
1071             }
1072             }
1073 16         148 $self->_update_regexp;
1074              
1075             # redefine comment macro
1076 16 100       459 $self->_define_standard_comment if $self->comment;
1077             }
1078              
1079             sub undefine_all_macro {
1080 8     8 1 20 my($self) = @_;
1081 8         27 $self->_undefine_all_macro_script(0);
1082             }
1083              
1084             sub undefine_all_script {
1085 8     8 1 16 my($self) = @_;
1086 8         28 $self->_undefine_all_macro_script(1);
1087             }
1088              
1089             sub undefine_all_variable {
1090 7     7 1 18 my($self) = @_;
1091              
1092             # delete all keys first and update regexp at the end
1093             # do not call _undefine_macro_script to avoid recomputing the regexp
1094             # after each deleted macro
1095 7         10 for my $name (keys %{ $self->variables }) {
  7         150  
1096 27         563 delete $self->variables->{$name};
1097 27         515 delete $self->actions->{'#'.$name};
1098             }
1099 7         57 $self->_update_regexp;
1100             }
1101              
1102             #------------------------------------------------------------------------------
1103             # deprecated method to define -macro, -script or -variable
1104             sub define {
1105 19     19 0 1375 my($self, $which, $name, $body) = @_;
1106              
1107 19 100       85 if ($which eq '-variable') {
    100          
    100          
1108 4         13 $self->define_variable($name, $body);
1109             }
1110             elsif ($which eq '-macro') {
1111 3         25 $self->define_macro($name, $body);
1112             }
1113             elsif ($which eq '-script') {
1114 11         24 $self->define_script($name, $body);
1115             }
1116             else {
1117 1         181 croak "$which method not supported";
1118             }
1119             }
1120              
1121             sub undefine {
1122 16     16 0 11457 my($self, $which, $name) = @_;
1123              
1124 16 100       91 if ($which eq '-variable') {
    100          
    100          
1125 4         15 $self->undefine_variable($name);
1126             }
1127             elsif ($which eq '-macro') {
1128 4         14 $self->undefine_macro($name);
1129             }
1130             elsif ($which eq '-script') {
1131 5         15 $self->undefine_script($name);
1132             }
1133             else {
1134 3         560 croak "$which method not supported";
1135             }
1136             }
1137              
1138             sub undefine_all {
1139 12     12 0 1731 my($self, $which) = @_;
1140 12   100     60 $which //= '';
1141            
1142 12 100       70 if ($which eq '-variable') {
    100          
    100          
1143 2         7 $self->undefine_all_variable;
1144             }
1145             elsif ($which eq '-macro') {
1146 2         7 $self->undefine_all_macro;
1147             }
1148             elsif ($which eq '-script') {
1149 3         8 $self->undefine_all_script;
1150             }
1151             else {
1152 5         952 croak "$which method not supported";
1153             }
1154             }
1155              
1156             sub list {
1157 27     27 0 49588 my($self, $which, $namesonly) = @_;
1158 27   100     84 $which //= '';
1159            
1160 27 100       98 if ($which eq '-variable') {
    100          
    100          
1161 8         19 $self->list_variable($namesonly);
1162             }
1163             elsif ($which eq '-macro') {
1164 8         22 $self->list_macro($namesonly);
1165             }
1166             elsif ($which eq '-script') {
1167 8         21 $self->list_script($namesonly);
1168             }
1169             else {
1170 3         578 croak "$which method not supported";
1171             }
1172             }
1173              
1174             1;
1175              
1176             =head1 NAME
1177              
1178             Text::MacroScript - A macro pre-processor with embedded perl capability
1179              
1180             =head1 SYNOPSIS
1181              
1182             use Text::MacroScript;
1183              
1184             # new() for macro processing
1185              
1186             my $Macro = Text::MacroScript->new;
1187             while( <> ) {
1188             print $Macro->expand( $_ ) if $_;
1189             }
1190              
1191             # Canonical use (the filename and line number improves error messages):
1192             my $Macro = Text::MacroScript->new;
1193             while( <> ) {
1194             print $Macro->expand( $_, $ARGV, $. ) if $_;
1195             }
1196              
1197             # new() for embedded macro processing
1198              
1199             my $Macro = Text::MacroScript->new( -embedded => 1 );
1200             # Delimiters default to <: and :>
1201             # or
1202             my $Macro = Text::MacroScript->new( -opendelim => '[[', -closedelim => ']]' );
1203             while( <> ) {
1204             print $Macro->expand( $_, $ARGV, $. ) if $_;
1205             }
1206              
1207             # Create a macro object and create initial macros/scripts from the file(s)
1208             # given:
1209             my $Macro = Text::MacroScript->new(
1210             -file => [ 'local.macro', '~/.macro/global.macro' ]
1211             );
1212              
1213             # Create a macro object and create initial macros/scripts from the
1214             # definition(s) given:
1215             my $Macro = Text::MacroScript->new(
1216             -macro => [
1217             [ 'MAX_INT' => '32767' ],
1218             ],
1219             -script => [
1220             [ 'DHM2S' =>
1221             [
1222             my $s = (#0*24*60*60)+(#1*60*60)+(#2*60);
1223             "#0 days, #1 hrs, #2 mins = $s secs"
1224             ],
1225             ],
1226             -variable => [ '*MARKER*' => 0 ],
1227             );
1228              
1229             # We may of course use any combination of the options.
1230              
1231             my $Macro = Text::MacroScript->new( -comment => 1 ); # Create the %%[] macro.
1232              
1233             # define()
1234             $Macro->define_macro( $macroname, $macrobody );
1235             $Macro->define_script( $scriptname, $scriptbody );
1236             $Macro->define_variable( $variablename, $variablebody );
1237              
1238             # undefine()
1239             $Macro->undefine_macro( $macroname );
1240             $Macro->undefine_script( $scriptname );
1241             $Macro->undefine_variable( $variablename );
1242              
1243             # undefine_all()
1244             $Macro->undefine_all_macro;
1245             $Macro->undefine_all_script;
1246             $Macro->undefine_all_variable;
1247              
1248             # list()
1249             @macros = $Macro->list_macro;
1250             @macros = $Macro->list_macro( -namesonly );
1251              
1252             @scripts = $Macro->list_script;
1253             @scripts = $Macro->list_script( -namesonly );
1254              
1255             @variables = $Macro->list_variable;
1256             @variables = $Macro->list_variable( -namesonly );
1257              
1258             # load_file() - always treats the contents as within delimiters if we are
1259             # doing embedded processing.
1260              
1261             $Macro->load_file( $filename );
1262              
1263             # expand_file() - calls expand() for each input line.
1264             $Macro->expand_file( $filename );
1265             @expanded = $Macro->expand_file( $filename );
1266            
1267             # expand()
1268             $expanded = $Macro->expand( $unexpanded );
1269             $expanded = $Macro->expand( $unexpanded, $filename, $line_nr );
1270              
1271             This bundle also includes the C and C scripts which allows us
1272             to expand macros without having to use/understand C,
1273             although you will have to learn the handful of macro commands available and
1274             which are documented here and in C. C provides more
1275             documentation on the embedded approach.
1276              
1277             The C library supplied provides some functions which you may
1278             choose to use in HTML work for example.
1279              
1280             =head1 MACRO SYSTEMS VS EMBEDDED SYSTEMS
1281              
1282             Macro systems read all the text, substituting anything which matches a macro
1283             name with the macro's body (or script name with the result of the execution of
1284             the script). This makes macro systems slower (they have to check for
1285             macro/script names everywhere, not just in a delimited section) and more risky
1286             (if we choose a macro/script name that normally occurs in the text we'll end
1287             up with a mess) than embedded systems. On the other hand because they work on
1288             the whole text not just delimited bits, macro systems can perform processing
1289             that embedded systems can't. Macro systems are used extensively, for example
1290             the CPP, C pre-processor, with its #DEFINE's, etc.
1291              
1292             Essentially, embedded systems print all text until they hit an opening
1293             delimiter. They then execute any code up until the closing delimiter. The text
1294             that results replaces everything between and including the delimeters. They
1295             then carry on printing text until they hit an opening delimeter and so on
1296             until they've finished processing all the text. This module now provides both
1297             approaches.
1298              
1299             =head1 DESCRIPTION
1300              
1301             Define macros, scripts and variables in macro files or directly in text files.
1302              
1303             Commands can appear in separate macro files which are loaded in either via the
1304             text files they process (e.g. via the L command), or can be embedded
1305             directly in text files. Almost every command that can appear in a file has an
1306             equivalent object method so that programmers can achieve the same things in
1307             code as can be achieved by macro commands in texts; there are also additional
1308             methods which have no command equivalents.
1309              
1310             Most the examples given here use the macro approach. However this module now
1311             directly supports an embedded approach and this is now documented. Although
1312             you can specify your own delimiters where shown in examples we use the default
1313             delimiters of C:> and C<:E> throughout.
1314              
1315             =head2 Public methods
1316              
1317             =head3 new
1318              
1319             $self = Text::MacroScript->new();
1320             $self = Text::MacroScript->new( %opts );
1321              
1322             Create a new C object, initialized with the supplied
1323             options. By default creates an object for macro processing.
1324              
1325             For macro processing:
1326              
1327             my $Macro = Text::MacroScript->new;
1328              
1329             For embedded macro processing:
1330              
1331             my $Macro = Text::MacroScript->new( -embedded => 1 );
1332             # Delimiters default to <: and :>
1333              
1334             Or specify your own delimiters:
1335            
1336             my $Macro = Text::MacroScript->new( -opendelim => '[[', -closedelim => ']]' );
1337              
1338             Or specify one delimiter to use for both (probably not wise):
1339              
1340             my $Macro = Text::MacroScript->new( -opendelim => '%%' );
1341             # -closedelim defaults to -opendelim, e.g. %% in this case
1342            
1343             The full list of options that can be specified at object creation:
1344              
1345             =over 4
1346              
1347             =item *
1348              
1349             C<-embedded =E 1>
1350              
1351             Create the object for embedded processing, with default C:> and
1352             C<:E> delimiters. If option value is C<0>, or if the option is not
1353             supplied, create the object for macro processing.
1354              
1355             =item *
1356              
1357             C<-opendelim =E '[[', -closedelim =E ']]'>
1358              
1359             Create the object for embedded processing, with the supplied C<[[> and
1360             C<]]> delimiters.
1361              
1362             =item *
1363              
1364             C<-opendelim =E '%%'>
1365              
1366             Create the object for embedded processing, with the same C as open
1367             and close delimiters.
1368              
1369             =item *
1370              
1371             C<-comment =E 1>
1372              
1373             Create the C<%%[]> comment macro.
1374              
1375             =item *
1376              
1377             C<-file =E [ @files ]>
1378              
1379             See also L and C.
1380              
1381             =item *
1382              
1383             C<-macro =E [ @macros ]>
1384              
1385             Define macros, where each macro is a pair of C body>, e.g.
1386              
1387             my $Macro = Text::MacroScript->new(-macro => [ ["name1"=>"body1"], ["name2"=>"body2"] ] );
1388              
1389             See also L.
1390              
1391             =item *
1392              
1393             C<-script =E [ @scripts ]>
1394              
1395             Define scripts, where each script is a pair of C body>, e.g.
1396              
1397             my $Macro = Text::MacroScript->new(-script => [ ["name1"=>"body1"], ["name2"=>"body2"] ] );
1398              
1399             See also L.
1400              
1401             =item *
1402              
1403             C<-variable =E [ @svariables ]>
1404              
1405             Define variables, where each variable is a pair of C value>, e.g.
1406              
1407             my $Macro = Text::MacroScript->new(-variable => [ ["name1"=>"value1"], ["name2"=>"value2"] ] );
1408              
1409             See also L.
1410              
1411             =back
1412              
1413             =head3 define_macro
1414              
1415             $Macro->define_macro( $name, $body );
1416              
1417             Defines a macro with the given name that expands to the given body when
1418             called. If a macro with the same name already exists, it is silently
1419             overwritten.
1420              
1421             This is the same as the deprecated syntax:
1422              
1423             $Macro->define( -macro, $name, $body );
1424              
1425             See also L.
1426              
1427             =head3 list_macro
1428              
1429             $Macro->list_macro; # lists to STDOUT
1430             @output = $Macro->list_macro; # lists to array
1431             $Macro->list_macro(-namesonly); # only names
1432              
1433             Lists all defined macros to C or returns the result if called in
1434             list context. Accepts an optional parameter C<-namesonly> to list only
1435             the macro names and not the body.
1436              
1437             =head3 undefine_macro
1438              
1439             $Macro->undefine_macro( $name );
1440              
1441             If a macro exists with the given name, it is deleted. If not, the function
1442             does nothing.
1443              
1444             This is the same as the deprecated syntax:
1445              
1446             $Macro->undefine( -macro, $name );
1447              
1448             See also L.
1449              
1450             =head3 undefine_all_macro
1451              
1452             $Macro->undefine_all_macro;
1453              
1454             Delete all the defined macros.
1455              
1456             This is the same as the deprecated syntax:
1457              
1458             $Macro->undefine_all( -macro );
1459              
1460             See also L.
1461              
1462             =cut
1463             # $Macro->define_macro( $name, \@arg_names, $body );
1464             #The optional array of C<@arg_names> contains the names of local variables
1465             #that are defined with the actual arguments passed to the macro when called.
1466             #The arguments are refered in the body as other variables, prefixed with
1467             #C<#>, e.g.
1468             #
1469             # $Macro->define_macro( 'ADD', ['A', 'B'], "#A+#B" );
1470             # $Macro->expand("ADD[2|3]"); --> "2+3"
1471              
1472             =head3 define_script
1473              
1474             $Macro->define_script( $name, $body );
1475              
1476             Defines a perl script with the given name that executes the given body
1477             when called. If a script with the same name already exists, it is
1478             silently overwritten.
1479              
1480             This is the same as the deprecated syntax:
1481              
1482             $Macro->define( -script, $name, $body );
1483              
1484             See also L.
1485              
1486             =head3 list_script
1487              
1488             $Macro->list_script; # lists to STDOUT
1489             @output = $Macro->list_script; # lists to array
1490             $Macro->list_script(-namesonly); # only names
1491              
1492             Lists all defined scripts to C or returns the result if called in
1493             list context. Accepts an optional parameter C<-namesonly> to list only
1494             the script names and not the body.
1495              
1496             =head3 undefine_script
1497              
1498             $Macro->undefine_script( $name );
1499              
1500             If a script exists with the given name, it is deleted. If not, the function
1501             does nothing.
1502              
1503             This is the same as the deprecated syntax:
1504              
1505             $Macro->undefine( -script, $name );
1506              
1507             See also L.
1508              
1509             =head3 undefine_all_script
1510              
1511             $Macro->undefine_all_script;
1512              
1513             Delete all the defined scripts.
1514              
1515             This is the same as the deprecated syntax:
1516              
1517             $Macro->undefine_all( -script );
1518              
1519             See also L.
1520              
1521             =cut
1522             # $Macro->define_script( $name, \@arg_names, $body );
1523             #
1524             #The optional array of C<@arg_names> contains the names of local variables
1525             #that are defined with the actual arguments passed to the script when called.
1526             #The arguments are referred in the body as other variables, prefixed with
1527             #C<#>, e.g.
1528             #
1529             # $Macro->define_script( 'ADD', ['A', 'B'], "#A+#B" );
1530             # $Macro->expand("ADD[2|3]"); --> "5"
1531              
1532             =head3 define_variable
1533              
1534             $Macro->define_variable( $name, $value );
1535              
1536             Defines or updates a variable that can be used within macros or perl scripts
1537             as C<#varname>.
1538              
1539             This is the same as the deprecated syntax:
1540              
1541             $Macro->define( -variable, $name, $value );
1542              
1543             See also L.
1544              
1545             =head3 list_variable
1546              
1547             $Macro->list_variable; # lists to STDOUT
1548             @output = $Macro->list_variable; # lists to array
1549             $Macro->list_variable(-namesonly); # only names
1550              
1551             Lists all defined variables to C or returns the result if called in
1552             list context. Accepts an optional parameter C<-namesonly> to list only
1553             the variable names and not the body.
1554              
1555             =head3 undefine_variable
1556              
1557             $Macro->undefine_variable( $name );
1558              
1559             If a variable exists with the given name, it is deleted. If not, the function
1560             does nothing.
1561              
1562             This is the same as the deprecated syntax:
1563              
1564             $Macro->undefine( -variable, $name );
1565              
1566             See also L.
1567              
1568             =head3 undefine_all_variable
1569              
1570             $Macro->undefine_all_variable;
1571              
1572             Delete all the defined variables.
1573              
1574             This is the same as the deprecated syntax:
1575              
1576             $Macro->undefine_all( -variable );
1577              
1578             See also L.
1579              
1580             =head3 expand
1581              
1582             $text = $Macro->expand( $in );
1583             $text = $Macro->expand( $in, $filename, $line_nr );
1584              
1585             Expands the given C<$in> input and returns the expanded text. The C<$in>
1586             is either a text line or an interator that returns a sequence of text
1587             lines.
1588              
1589             The C<$filename> is optional and defaults to C<"-">. The <$line_nr> is
1590             optional and defaults to C<1>. They are used in error messages to locate
1591             the error.
1592              
1593             The expansion processes any macro definitions and expands any macro
1594             calls found in the input text. C buffers internally all the
1595             lines required for a multi-line definition, i.e. it can be called once
1596             for each line of a multi-line L.
1597              
1598             =head3 load_file
1599              
1600             $Macro->load_file( $filename );
1601              
1602             See also L and C.
1603              
1604             =head3 expand_file
1605              
1606             $Macro->expand_file( $filename );
1607             @expanded = $Macro->expand_file( $filename );
1608              
1609             When called in C context, sends output to the current output
1610             filehandle. When called in C context, returns the list of
1611             expaned lines.
1612              
1613             Calls C on each line of the file.
1614              
1615             See also L.
1616              
1617             =head1 MACRO LANGUAGE
1618              
1619             This chapter describes the macro language statements processed in the
1620             input files.
1621              
1622             =head2 Defining and using macros
1623              
1624             These commands can appear in separate I files, and/or in the body of
1625             files. Wherever a macroname or scriptname is encountered it will be replaced
1626             by the body of the macro or the result of the evaluation of the script using
1627             any parameters that are given.
1628              
1629             Note that if we are using an embedded approach commands, macro names and
1630             script names should appear between delimiters. (Except when we L since
1631             this assumes the whole file is I.
1632              
1633             =head3 %DEFINE
1634              
1635             %DEFINE macroname [macro body]
1636             %DEFINE macroname
1637             multi-line
1638             macro body
1639             #0, #1 are the first and second parameters if any used
1640             %END_DEFINE
1641              
1642             Thus, in the body of a file we may have, for example:
1643              
1644             %DEFINE &B [Billericky Rickety Builders]
1645             Some arbitrary text.
1646             We are writing to complain to the &B about the shoddy work they did.
1647              
1648             If we are taking the embedded approach the example above might become:
1649              
1650             <:%DEFINE BB [Billericky Rickety Builders]:>
1651             Some arbitrary text.
1652             We are writing to complain to the <:BB:> about the shoddy work they did.
1653              
1654             When using an embedded approach we don't have to make the macro or script name
1655             unique within the text, (although each must be distinct from each other),
1656             since the delimiters are used to signify them. However since expansion applies
1657             recursively it is still wise to make names distinctive.
1658              
1659             In files we would write:
1660              
1661             %DEFINE MAC [The Mackintosh Macro]
1662              
1663             The equivalent method call is:
1664              
1665             $Macro->define_macro( 'MAC', 'The Mackintosh Macro' );
1666              
1667             We can call our macro anything, excluding white-space and special
1668             characters used while parsing the input text (C<[,],(,),#>).
1669              
1670             All names are case-sensitive.
1671              
1672             So a name like C<%*&!> is fine - indeed names which
1673             could not normally appear in the text are recommended to avoid having the
1674             wrong thing substituted. We should also avoid calling macros, scripts or
1675             variables names beginning with C<#>.
1676              
1677             Note that if we define a macro and then a script with the same name the
1678             script will effectively replace the macro.
1679              
1680             We can have parameters (for macros and scripts), e.g.:
1681              
1682             %DEFINE *P [The forename is #0 and the surname is #1]
1683              
1684             Parameters used in the source text can contain square brackets since macro
1685             will grab up to the last square bracket on the line. The only thing we can't
1686             pass are C<|>s since these are used to separate parameters. White-space between
1687             the macro name and the C<[> is optional in definitions but I in the
1688             source text.
1689              
1690             Parameters are named C<#0>, C<#1>, etc. There is a limit of 100 parameters, i.e.
1691             C<#0..#99>, and we must use all those we specify. In the example above we I
1692             use C<*P[param1|param2]>, e.g. C<*P[Jim|Hendrix]>; if we don't
1693             C will croak. Note that macro names and their parameters
1694             must all be on the same line (although this is relaxed if you use paragraph
1695             mode).
1696              
1697             Because we use C<#> to signify parameters if you require text that consists of a
1698             C<#> followed by digits then you should escape the C<#>, e.g.
1699              
1700             %DEFINE *GRAY[#0]
1701              
1702             We can use as many I parameters than we need, for example add a third to
1703             document: C<*P[Jim|Hendrix|Musician]> will become
1704             I<'The forename is Jim and the surname is Hendrix'>,
1705             just as in the previous example; the third parameter,
1706             I<'Musician'>, will simply be thrown away.
1707              
1708             If we take an embedded approach we might write this example thus:
1709              
1710             <:%DEFINE P [The forename is #0 and the surname is #1]:>
1711              
1712             and in the text, <:P[Jim|Hendrix]:> will be transformed appropriately.
1713              
1714             If we define a macro, script or variable and later define the same name the
1715             later definition will replace the earlier one. This is useful for making local
1716             macro definitions over-ride global ones, simply by loading the global ones
1717             first.
1718              
1719             Although macros can have plain textual names like this:
1720              
1721             %DEFINE MAX_INT [32767]
1722              
1723             It is generally wise to use a prefix and/or suffix to make sure we don't
1724             expand something unintentionally, e.g.
1725              
1726             %DEFINE $MAX_INT [65535]
1727              
1728             B -
1729             B
1730              
1731             Multi-line definitions are permitted (here's an example I use with the lout
1732             typesetting language):
1733              
1734             %DEFINE SCENE
1735             @Section
1736             @Title {#0}
1737             @Begin
1738             @PP
1739             @Include {#1}
1740             @End @Section
1741             %END_DEFINE
1742              
1743             This allows us to write the following in our lout files:
1744              
1745             SCENE[ The title of the scene | scene1.lt ]
1746              
1747             which is a lot shorter than the definition.
1748              
1749             The body of a macro may not contain a literal null. If you really need one
1750             then use a script and represent the null as C.
1751              
1752             B
1753              
1754             This can be achieved very simply. For a one line macro simply enclose the
1755             body between qq{ and }, e.g.
1756              
1757             %DEFINE $SURNAME [Baggins]
1758              
1759             becomes
1760              
1761             %DEFINE_SCRIPT $SURNAME [qq{Baggins}]
1762              
1763             For a multi-line macro use a here document, e.g.
1764              
1765             %DEFINE SCENE
1766             @Section
1767             @Title {#0}
1768             @Begin
1769             @PP
1770             @Include {#1}
1771             @End @Section
1772             %END_DEFINE
1773              
1774             becomes
1775              
1776             %DEFINE_SCRIPT SCENE
1777             <<__EOT__
1778             \@Section
1779             \@Title {#0}
1780             \@Begin
1781             \@PP
1782             \@Include {#1}
1783             \@End \@Section
1784             __EOT__
1785             %END_DEFINE
1786              
1787             Note that the C<@s> had to be escaped because they have a special meaning in
1788             perl.
1789              
1790             =head3 %UNDEFINE
1791              
1792             Macros can be undefined in files:
1793              
1794             %UNDEFINE *P
1795              
1796             and in code:
1797              
1798             $Macro->undefine_macro('*P');
1799              
1800             Undefining a non-existing macro is not considered an error.
1801              
1802             =head3 %UNDEFINE_ALL
1803              
1804             All macros can be undefined in files:
1805              
1806             %UNDEFINE_ALL
1807              
1808             and in code:
1809              
1810             $Macro->undefine_all_macro;
1811              
1812             =head3 %DEFINE_SCRIPT
1813              
1814             Instead of straight textual substitution, we can have some perl executed
1815             (after any parameters have been replaced in the perl text):
1816              
1817             %DEFINE_SCRIPT *ADD ["#0 + #1 = " . (#0 + #1)]
1818              
1819             or by using the equivalent method call:
1820              
1821             $Macro->define_script( '*ADD', '"#0 + #1 = " . (#0 + #1)' );
1822              
1823             We can call our script anything, excluding white-space characters special
1824             characters used while parsing the input text (C<[,],(,),#>).
1825              
1826             All names are case-sensitive.
1827              
1828             These would be used as C<*ADD[5|11]> in the text
1829              
1830             which would be output as:
1831              
1832             These would be used as 5 + 11 = 16 in the text
1833              
1834             In script definitions we can use an alternative way of passing parameters
1835             instead of or in addition to the C<#0> syntax.
1836              
1837             This is particularly useful if we want to take a variable number of parameters
1838             since the C<#0> etc syntax does not provide for this. An array called C<@Param>
1839             is available to our perl code that has any parameters. This allows things
1840             like the following to be achieved:
1841              
1842             %DEFINE_SCRIPT ^PEOPLE
1843             # We don't use the name hash number params but read straight from the
1844             # array:
1845             my $a = "friends and relatives are ";
1846             $a .= join ", ", @Param;
1847             $a;
1848             %END_DEFINE
1849              
1850             The above would expand in the following text:
1851              
1852             Her ^PEOPLE[Anna|John|Zebadiah].
1853              
1854             to
1855              
1856             Her friends and relatives are Anna, John, Zebadiah.
1857              
1858             In addition to having access to the parameters either using the C<#0> syntax or
1859             the C<@Param> array, we can also access any variables that have been defined
1860             using L. These are accessible either using
1861             C<#variablename> similarly to the <#0> parameter syntax, or via the C<%Var> hash.
1862             Although we can change both C<@Param> and C<%Var> elements in our script,
1863             the changes to C<@Param> only apply within the script whereas changes to
1864             C<%Var> apply from that point on globally.
1865              
1866             Note that if you require a literal C<#> followed by digits in a script body then
1867             you must escape the C<#> like this C<\#>.
1868              
1869             Here's a simple date-stamp style:
1870              
1871             %DEFINE_SCRIPT *DATESTAMP
1872             use POSIX;
1873             "#0 on ".strftime("%Y/%m/%d", localtime(time));
1874             %END_DEFINE
1875              
1876             If we wanted to add the above in code we'd have to make sure the
1877             C<$variables> weren't interpolated:
1878              
1879             $Macro->define_script( '*DATESTAMP', <<'__EOT__' );
1880             use POSIX;
1881             "#0 on ".strftime("%Y/%m/%d", localtime(time));
1882             __EOT__
1883              
1884             Here's (a somewhat contrived example of) how the above would be used:
1885              
1886            
1887             Test Page
1888            
1889             *DATESTAMP[Last Updated]

1890             This page is up-to-date and will remain valid until *DATESTAMP[midnight]
1891            
1892            
1893              
1894             Thus we could have a file, C containing:
1895              
1896             %DEFINE_SCRIPT *DATESTAMP
1897             use POSIX;
1898             "#0 on ".strftime("%Y/%m/%d", localtime(time));
1899             %END_DEFINE
1900            
1901             Test Page
1902            
1903             *DATESTAMP[Last Updated]

1904             This page is up-to-date and will remain valid until *DATESTAMP[midnight]
1905            
1906            
1907              
1908             which when expanded, either in code using C<$Macro-Eexpand()>, or using the
1909             simple C utility supplied with C:
1910              
1911             % macropp test.html.m > test.html
1912              
1913             C will contain just this:
1914              
1915            
1916             Test Page
1917            
1918             Last Updated on 1999/08/21

1919             This page is up-to-date and will remain valid until midnight on 1999/08/21
1920            
1921            
1922              
1923             Of course in practice we wouldn't want to define everything in-line like this.
1924             See L later for an alternative.
1925              
1926             This example written in embedded style might be written thus:
1927              
1928             <:
1929             %DEFINE_SCRIPT DATESTAMP
1930             use POSIX;
1931             "#0 on ".strftime("%Y/%m/%d", localtime(time));
1932             %END_DEFINE
1933             :>
1934            
1935             Test Page
1936            
1937            
1938             <:DATESTAMP[Last Updated]:>

1939             This page is up-to-date and will remain valid until <:DATESTAMP[midnight]:>
1940            
1941            
1942              
1943             For more (and better) HTML examples see the example file C.
1944              
1945             The body of a script may not contain a literal null. If you really need one
1946             then represent the null as C.
1947              
1948             =head3 %UNDEFINE_SCRIPT
1949              
1950             Scripts can be undefined in files:
1951              
1952             %UNDEFINE_SCRIPT *DATESTAMP
1953              
1954             and in code:
1955              
1956             $Macro->undefine_script('*DATESTAMP');
1957              
1958             Undefining a non-existing script is not considered an error.
1959              
1960             =head3 %UNDEFINE_ALL_SCRIPT
1961              
1962             All scripts can be undefined in files:
1963              
1964             %UNDEFINE_ALL_SCRIPT
1965              
1966             and in code:
1967              
1968             $Macro->undefine_all_script;
1969              
1970             =head3 %DEFINE_VARIABLE
1971              
1972             We can also define variables:
1973              
1974             %DEFINE_VARIABLE &*! [89.1232]
1975              
1976             or in code:
1977              
1978             $Macro->define_variable( '&*!', 89.1232 );
1979              
1980             Note that there is no multi-line version of L.
1981              
1982             All current variables are available inside L macros and
1983             L as C<#varname>. Inside L scripts they
1984             are also available in the C<%Var> hash:
1985              
1986             %DEFINE_SCRIPT *TEST1
1987             $a = '';
1988             while( my( $key, $val ) each( %Var ) ) {
1989             $a .= "$key = $val\n";
1990             }
1991             $a;
1992             %END_DEFINE
1993              
1994             Here's another example:
1995            
1996             %DEFINE_VARIABLE XCOORD[256]
1997             %DEFINE_VARIABLE YCOORD[112]
1998             The X coord is *SCALE[X|16] and the Y coord is *SCALE[Y|16]
1999            
2000             %DEFINE_SCRIPT *SCALE
2001             my $coord = shift @Param;
2002             my $scale = shift @Param;
2003             my $val = $Var{$coord};
2004             $val %= scale; # Scale it
2005             $val;
2006             %END_DEFINE
2007            
2008             Variables can be modified within script Ls, e.g.
2009              
2010             %DEFINE_VARIABLE VV[Foxtrot]
2011             # VV eq 'Foxtrot'
2012             # other text
2013             # Here we use the #variable synax:
2014             %DEFINE_SCRIPT VV[#VV='Alpha']
2015             # VV eq 'Alpha' - note that we *must* refer to the script (as we've done
2016             # on the line following) for it to execute.
2017             # other text
2018             # Here we use perl syntax:
2019             %DEFINE_SCRIPT VV[$Var{'VV'}='Tango']
2020             # VV eq 'Tango' - note that we *must* refer to the script (as we've done
2021             # on the line following) for it to execute.
2022              
2023             As we can see variables support the C<#variable> syntax similarly to parameters
2024             which support C<#0> etc and ara available in scripts via the C<@Param> array.
2025             Note that changing parameters within a script only apply within the script;
2026             whereas changing variables in the C<%Var> hash in a script changes them from
2027             that point on globally.
2028              
2029             Variables are also used with L.
2030              
2031             =head3 %UNDEFINE_VARIABLE
2032              
2033             Variables can be undefined in files:
2034              
2035             %UNDEFINE_VARIABLE &*!
2036              
2037             and in code:
2038              
2039             $Macro->undefine_variable('&*!');
2040              
2041             Undefining a non-existing variable is not considered an error.
2042              
2043             =head3 %UNDEFINE_ALL_VARIABLE
2044              
2045             All variables can be undefined in files:
2046              
2047             %UNDEFINE_ALL_VARIABLE
2048              
2049             and in code:
2050              
2051             $Macro->undefine_all_variable;
2052              
2053             One use of undefining everything is to ensure we get a clean start. We might
2054             head up our files thus:
2055              
2056             %UNDEFINE_ALL
2057             %UNDEFINE_ALL_SCRIPT
2058             %UNDEFINE_ALL_VARIABLE
2059             %LOAD[mymacros]
2060             text goes here
2061              
2062             =head2 Loading and including files
2063              
2064             Although we can define macros directly in the files that require them it is often
2065             more useful to define them separately and include them in all those that need
2066             them.
2067              
2068             One way of achieving this is to load in the macros/scripts first and then
2069             process the file(s). In code this would be achieved like this:
2070              
2071             $Macro->load_file( $macro_file ); # loads definitions only
2072             $Macro->expand_file( $file ); # expands definitions to STDOUT
2073             my @expanded = $Macro->expand_file( $file ); # expands to array.
2074              
2075             From the command line it would be achieved thus:
2076              
2077             % macropp -f html.macros test.html.m > test.html
2078              
2079             One disadvantage of this approach, especially if we have lots of macro files,
2080             is that we can easily forget which macro files are required by which text
2081             files. One solution to this is to go back to C<%DEFINE>ing in the text files
2082             themselves, but this would lose reusability. The answer to both these problems
2083             is to use the C<%LOAD> command which loads the definitions from the named file at
2084             the point it appears in the text file:
2085              
2086             %LOAD[~/.macro/html.macros]
2087            
2088             Test Page Again
2089            
2090             *DATESTAMP[Last Updated]

2091             This page will remain valid until *DATESTAMP[midnight]
2092            
2093            
2094              
2095             The above text has the same output but we don't have to remember or explicitly
2096             load the macros. In code we can simply do this:
2097              
2098             my @expanded = $Macro->expand_file( $file );
2099              
2100             or from the command line:
2101              
2102             % macropp test.html.m > test.html
2103              
2104             At the beginning of our lout typesetting files we might put this line:
2105              
2106             %LOAD[local.macros]
2107              
2108             The first line of the C file is:
2109              
2110             %LOAD[~/.macro/lout.macros]
2111              
2112             So this loads both global macros then local ones (which if they have the same
2113             name will of course over-ride).
2114              
2115             This saves repeating the C<%DEFINE> definitions in all the files and makes
2116             maintenance easier.
2117              
2118             C<%LOAD> loads perl scripts and macros, but ignores any other text. Thus we can
2119             use C<%LOAD>, or its method equivalent C, on I file, and it
2120             will only ever instantiate macros and scripts and produce no output. When we
2121             are using embedded processing any file C<%LOAD>ed is treated as if wrapped in
2122             delimiters.
2123              
2124             If we want to include the entire contents of another file, and perform macro
2125             expansion on that file then use C<%INCLUDE>, e.g.
2126              
2127             %INCLUDE[/path/to/file/with/scripts-and-macros-and-text]
2128              
2129             The C<%INCLUDE> command will instantiate any macros and scripts it encounters
2130             and include all other lines of text (with macro/script expansion) in the
2131             output stream.
2132              
2133             Macros and scripts are expanded in the following order:
2134             1. scripts (longest named first, shortest named last)
2135             2. macros (longest named first, shortest named last)
2136              
2137             =head3 %LOAD
2138              
2139             %LOAD[file]
2140              
2141             or its code equivalent
2142              
2143             $Macro->load_file( $filename );
2144              
2145             instatiates any definitions that appear in the file, but ignores any other text
2146             and produces no output. When we are using embedded processing any file
2147             Led is treated as if wrapped in delimiters.
2148              
2149             This is equivalent to calling C.
2150              
2151             New defintions of the same macro override old defintions, thus one can first
2152             L a global macro file, and then a local project file that can override
2153             some of the global macros.
2154              
2155             =head3 %INCLUDE
2156              
2157             %INCLUDE[file]
2158              
2159             or its code equivalent
2160              
2161             $Macro->expand_file( $filename );
2162              
2163             instatiates any definitions that appear in the file, expands definitions
2164             and sends any other text to the current output filehandle.
2165              
2166             =head3 %REQUIRE
2167              
2168             We often want our scripts to have access to a bundle of functions that we have
2169             created or that are in other modules. This can now be achieved by:
2170              
2171             %REQUIRE[/path/to/mylibrary.pl]
2172              
2173             An example library C is provided with examples of usage in
2174             C.
2175              
2176             There is no equivalent object method because if we're writing code we can
2177             C or c as needed and if we're writing macros then we use
2178             L.
2179              
2180             =head2 Control Structures
2181              
2182             =head3 %CASE
2183              
2184             It is possible to selectively skip parts of the text.
2185              
2186             %CASE[0]
2187             All the text here will be discarded.
2188             No matter how much there is.
2189             This is effectively a `comment' case.
2190             %END_CASE
2191              
2192             The above is useful for multi-line comments.
2193              
2194             We can also skip selectively. Here's an if...then:
2195              
2196             %CASE[#OS eq 'Linux']
2197             Skipped if the condition is FALSE.
2198             %END_CASE
2199              
2200             The condition can be any perl fragment. We can use previously defined
2201             variables either using the C<#variable> syntax as shown above or using the
2202             exported perl name, thus in this case either C<#OS>, or C<%Var{'OS'}>
2203             whichever we prefer.
2204              
2205             If the condition is true the text is output with macro/script expansion as
2206             normal; if the condition is false the text is skipped.
2207              
2208             The if...then...else structure:
2209              
2210             %DEFINE_VARIABLE OS[Linux]
2211              
2212             %CASE[$Var{'OS'} eq 'Linux']
2213             Linux specific stuff.
2214             %CASE[#OS ne 'Linux']
2215             Non-linux stuff - note that both references to the OS variable are
2216             identical in the expression (#OS is converted internally to $Var{'0S'} so
2217             the eval sees the same code in both cases
2218             %END_CASE
2219              
2220             Although nested Ls are not supported we can get the same functionality
2221             (and indeed more versatility because we can use full perl expressions), e.g.:
2222              
2223             %DEFINE_VARIABLE TARGET[Linux]
2224              
2225             %CASE[#TARGET eq 'Win32' or #TARGET eq 'DOS']
2226             Win32/DOS stuff.
2227             %CASE[#TARGET eq 'Win32']
2228             Win32 only stuff.
2229             %CASE[#TARGET eq 'DOS']
2230             DOS only stuff.
2231             %CASE[#TARGET eq 'Win32' or #TARGET eq 'DOS']
2232             More Win32/DOS stuff.
2233             %END_CASE
2234              
2235             Although C doesn't support nested L's we can still represent
2236             logic like this:
2237              
2238             if cond1 then
2239             if cond2
2240             do cond1 + cond2 stuff
2241             else
2242             do cond1 stuff
2243             end if
2244             else
2245             do other stuff
2246             end if
2247              
2248             By `unrolling' the expression and writing something like this:
2249              
2250             %CASE[#cond1 and #cond2]
2251             do cond1 + cond2 stuff
2252             %CASE[#cond1 and (not #cond2)]
2253             do cond1 stuff
2254             %CASE[(not #cond1) and (not #cond2)]
2255             do other stuff
2256             %END_CASE
2257              
2258             In other words we must fully specify the conditions for each case.
2259              
2260             We can use any other macro/script command within L commands, e.g.
2261             Ls, etc., as well as have any text that will be macro/script expanded
2262             as normal.
2263              
2264             =head2 Comments
2265              
2266             Generally the text files that we process are in formats that support
2267             commenting, e.g. HTML:
2268              
2269            
2270              
2271             Sometimes however we want to put comments in our macro source files that won't
2272             end up in the output files. One simple way of achieving this is to define a
2273             macro whose body is empty; when its called with any number of parameters (our
2274             comments), their text is thrown away:
2275              
2276             %DEFINE %%[]
2277              
2278             which is used like this in texts:
2279              
2280             The comment comes %%[Here | [anything] put here will disappear]here!
2281              
2282             The output of the above will be:
2283              
2284             The comment comes here!
2285              
2286             We can add the definition in code:
2287              
2288             $Macro->define( -macro, '%%', '' );
2289              
2290             Or the macro can be added automatically for us when we create the Macro
2291             object:
2292              
2293             my $Macro = Text::MacroScript->new( -comment => 1 );
2294             # All other options may be used too of course.
2295              
2296             However the easiest way to comment is to use L:
2297              
2298             %CASE[0]
2299             This unconditionally skips text up until the end marker since the
2300             condition is always false.
2301             %END_CASE
2302              
2303             =head1 IMPORTABLE FUNCTIONS
2304              
2305             In version 1.25 I introduced some useful importable functions. These have now
2306             been removed from the module. Instead I supply a perl library C
2307             which has these functions (abspath, relpath, today) since Text::MacroScript
2308             can now `require' in any library file you like using the L
2309             directive.
2310              
2311             =head1 EXAMPLES
2312              
2313             I now include a sample C file for use with HTML documents. It uses
2314             the C program (supplied). The macro examples include macros which
2315             use C and also two macros which will include `new' and `updated'
2316             images up until a specified expiry date using variables.
2317              
2318             (Also see DESCRIPTION.)
2319              
2320             =head1 BUGS
2321              
2322             Lousy error reporting for embedded perl in most cases.
2323              
2324             =head1 AUTHOR
2325              
2326             Mark Summerfield. I can be contacted as -
2327             please include the word 'macro' in the subject line.
2328              
2329             =head1 MAINTAINER
2330              
2331             Since 2015, Paulo Custodio.
2332              
2333             This module repository is kept in Github, please feel free to submit issues,
2334             fork and send pull requests.
2335              
2336             https://github.com/pauloscustodio/Text-MacroScript
2337              
2338             =head1 COPYRIGHT
2339              
2340             Copyright (c) Mark Summerfield 1999-2000. All Rights Reserved.
2341              
2342             Copyright (c) Paulo Custodio 2015. All Rights Reserved.
2343              
2344             This module may be used/distributed/modified under the LGPL.
2345              
2346             =cut