1 #####################################################################
3 # Artemus - Template Toolkit version 5
5 # Copyright (C) 2000/2011 Angel Ortega <angel@triptico.com>
7 # This program is free software; you can redistribute it and/or
8 # modify it under the terms of the GNU General Public License
9 # as published by the Free Software Foundation; either version 2
10 # of the License, or (at your option) any later version.
12 # This program is distributed in the hope that it will be useful,
13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with this program; if not, write to the Free Software
19 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
23 #####################################################################
33 $Art5::VERSION
= '5.0.2-dev';
40 # delete leading blanks and a possible brace
41 $$seq =~ s/^\s*\{?\s*//;
45 if ($$seq =~ s/^#.*$//gm) {
48 elsif ($$seq =~ s/^(@?)"(([^"\\]*(\\.[^"\\]*)*))"\s*//) {
49 # double quoted string
53 # replace usual escaped characters
60 push(@ret, [ $op, $str ]);
62 elsif ($$seq =~ s/^(@?)'(([^'\\]*(\\.[^'\\]*)*))'\s*//) {
63 # single quoted string
70 push(@ret, [ $op, $str ]);
72 elsif ($$seq =~ s/^(\d+(\.\d+)?)\s*//) {
74 push(@ret, [ '"', $1 ]);
76 elsif ($$seq =~ /^\{\s*/) {
77 # another code sequence
78 push(@ret, $self->parse($seq));
80 elsif ($$seq =~ s/^\}\s*//) {
84 elsif ($$seq =~ s/^%([^\s\{\}]+)\s*//) {
86 push(@ret, [ '%', $1 ]);
88 elsif ($$seq =~ s/^\$(\d+)\s*//) {
90 push(@ret, [ '$', $1 ]);
92 elsif ($$seq =~ s/^([^\s\{\}]+)\s*//) {
95 # nothing yet? operator call
96 if (scalar(@ret) == 0) {
104 croak
"Artemus5 syntax error near '$$seq'";
108 # no program? return a NOP */
113 # is the first thing in the sequence an array
114 # (instruction) and not a string (opcode)?
115 if (ref($ret[0]) eq 'ARRAY') {
116 # only one instruction? return as is
117 if (scalar(@ret) == 1) {
121 # otherwise, prepend a '?' (joiner)
133 # was this code already compiled?
134 if (!exists($self->{pc
}->{$str})) {
138 # split by the Artemus5 marks
139 my @stream = split(/(<\{|\}>)/, $str);
141 # alternate between literal strings and Artemus5 code
143 my $p = shift(@stream);
146 $p = '{' . shift(@stream) . '}';
147 push(@ret, $self->parse(\
$p));
151 push(@ret, [ '"', $p ]);
157 $self->{pc
}->{$str} = $ret;
160 return $self->{pc
}->{$str};
168 if (!exists($self->{op
}->{$op})) {
171 # filter opcode to only allow
172 # characters valid in file names
173 $op =~ s/[^\w\d_-]//g;
175 # does a loader_func() exist?
176 if (ref($self->{loader_func
}) eq 'CODE') {
177 $src = $self->{loader_func
}->($op);
180 if (!defined($src)) {
181 # try to resolve by loading
182 # a source file from the path
183 foreach my $p (@
{$self->{path
}}) {
184 my $fp = $p . '/' . $op;
186 # does a precompiled script already exist?
187 if ($self->{cache
} && -f
$fp) {
188 my $cp = $self->{cache
} . $op;
190 if (-f
$cp && -M
$cp < -M
$fp) {
191 # it does and it's fresh; import wildly
192 $self->{op
}->{$op} = eval "require '$cp'";
199 $src = join('', <F
>);
207 # compile if available
209 $self->{op
}->{$op} = $self->compile($src);
211 # if there is a cache directory, save the compiled code
212 if ($self->{cache
} and open(F
, '>' . $self->{cache
} . $op)) {
215 print F Dumper
($self->{op
}->{$op});
221 return $self->{op
}->{$op};
230 if (ref($prg) && !$self->{abort
}) {
231 # has additional arguments?
232 # push them to the stack
234 push(@
{$self->{stack
}}, [ @_ ]);
237 # stream of Artemus5 code
238 my @stream = @
{$prg};
241 my $op = shift(@stream);
244 my $c = $self->code($op);
246 if (ref($c) eq 'CODE') {
247 $ret = $c->(@stream);
249 elsif (ref($c) eq 'ARRAY') {
250 # push the arguments to the stack
251 push(@
{$self->{stack
}},
252 [ map { $self->exec($_); }
255 $ret = $self->exec($c);
258 pop(@
{$self->{stack
}});
261 croak
"Artemus5 opcode not found: $op";
264 # additional arguments?
265 # pop them from the stack
267 pop(@
{$self->{stack
}});
271 if (!defined($ret)) {
282 return $self->exec(@_) || 0;
289 $self->{stack
} = [ [] ];
291 $self->{op
}->{VERSION
} = [ '"', $Art5::VERSION
];
293 $self->{op
}->{VERSION_STR
} = [
294 '?', [ '"', 'Artemus ' ], [ 'VERSION' ]
298 $self->{op
}->{'"'} = sub {
302 # translateable literal
303 $self->{op
}->{'@'} = sub {
304 return $self->{t
}->{$_[0]} || $_[0];
308 $self->{op
}->{'$'} = sub {
309 return $self->{stack
}->[-1]->[$_[0]];
312 # external hash (e.g. CGI variables)
313 $self->{op
}->{'%'} = sub {
316 return $var eq '%' ?
$self->{xh
} : $self->{xh
}->{$var};
320 $self->{op
}->{'?'} = sub {
321 if (scalar(@_) == 1) {
322 return $self->exec($_[0]);
325 return join('', map { $self->exec($_); } @_);
329 $self->{op
}->{'&'} = sub {
330 return [ map { $self->exec($_); } @_ ];
334 $self->{op
}->{'='} = sub {
335 $self->{op
}->{$self->exec($_[0])} =
336 [ '"', $self->exec($_[1]) ];
341 # list of translation pairs
342 $self->{op
}->{'T'} = sub {
343 while (scalar(@_) > 1) {
344 my $k = $self->exec(shift);
345 my $v = $self->exec(shift);
347 $self->{t
}->{$k} = $v;
353 $self->{op
}->{eq} = sub {
354 $self->exec($_[0]) eq
355 $self->exec($_[1]) ?
1 : 0;
357 $self->{op
}->{ne} = sub {
358 $self->exec($_[0]) ne
359 $self->exec($_[1]) ?
1 : 0;
362 $self->{op
}->{and} = sub {
363 $self->exec($_[0]) && $self->exec($_[1]);
365 $self->{op
}->{or} = sub {
366 $self->exec($_[0]) || $self->exec($_[1]);
368 $self->{op
}->{not} = sub {
369 $self->exec($_[0]) ?
0 : 1;
372 $self->{op
}->{if} = sub {
375 if ($self->exec($_[0])) {
376 $ret = $self->exec($_[1]);
378 elsif (scalar(@_) == 3) {
379 $ret = $self->exec($_[2]);
385 $self->{op
}->{add
} = sub {
386 return $self->exec0($_[0]) + $self->exec0($_[1]);
388 $self->{op
}->{sub} = sub {
389 return $self->exec0($_[0]) - $self->exec0($_[1]);
391 $self->{op
}->{mul
} = sub {
392 return $self->exec0($_[0]) * $self->exec0($_[1]);
394 $self->{op
}->{div
} = sub {
395 return $self->exec0($_[0]) / $self->exec0($_[1]);
398 $self->{op
}->{gt} = sub {
399 return $self->exec0($_[0]) > $self->exec0($_[1]);
401 $self->{op
}->{lt} = sub {
402 return $self->exec0($_[0]) < $self->exec0($_[1]);
404 $self->{op
}->{random
} = sub {
405 return $self->exec($_[rand(scalar(@_))]);
408 $self->{op
}->{env
} = sub {
409 # no arguments? return keys as an arrayref
410 if (scalar(@_) == 0) {
411 return [ keys(%ENV) ];
414 return $ENV{$self->exec($_[0])};
417 $self->{op
}->{foreach} = sub {
419 my $code = shift || [ '$', 0 ];
420 my $sep = shift || [ '"', '' ];
421 my $header = shift || [ '"', '' ];
426 foreach my $e (@
{$self->exec($list)}) {
427 # create a stack for the elements
428 # and store the element in the stack
429 push(@
{$self->{stack
}}, ref($e) ?
$e : [ $e ]);
431 # execute the header code
432 my $o = $self->exec($header);
434 # if it's different from previous header,
435 # strip from output; otherwise, remember
444 # execute the body code
445 $o .= $self->exec($code);
450 pop(@
{$self->{stack
}});
453 return join($self->exec($sep), @ret);
456 $self->{op
}->{case
} = sub {
457 my $value = $self->exec(shift);
460 # if args are odd, the last one is
461 # the 'otherwise' case
462 if (scalar(@_) % 2) {
466 # now treat the rest of arguments as
467 # pairs of case / result
469 my $case = $self->exec(shift);
472 if ($value eq $case) {
473 return $self->exec($res);
477 return defined($oth) ?
$self->exec($oth) : '';
480 $self->{op
}->{seq
} = sub {
481 my $from = $self->exec0(shift);
482 my $to = $self->exec0(shift);
484 return [ $from .. $to ];
487 $self->{op
}->{sort} = sub {
488 my $list = $self->exec(shift);
489 my $code = shift || [ '$', 0 ];
491 # create a stack for the elements
492 push(@
{$self->{stack
}}, []);
495 $self->{stack
}->[-1] = ref($a) ?
$a : [ $a ];
496 my $va = $self->exec($code);
498 $self->{stack
}->[-1] = ref($b) ?
$b : [ $b ];
499 my $vb = $self->exec($code);
505 pop(@
{$self->{stack
}});
510 $self->{op
}->{reverse} = sub {
511 return [ reverse @
{$self->exec(shift)} ];
514 $self->{op
}->{size
} = sub { return scalar @
{$self->exec($_[0])} };
516 $self->{op
}->{split} = sub {
517 if (scalar(@_) == 3) {
518 return [ map { [ split($self->exec($_[1]), $_) ] }
519 split($self->exec($_[0]), $self->exec($_[2]))
522 return [ split($self->exec($_[0]), $self->exec($_[1])) ];
525 $self->{op
}->{dump} = sub {
528 return Dumper
($self->exec($_[0]));
531 $self->{xh
}->{arch
} = 'Unix';
541 my $c = $self->compile($src);
543 return $self->exec($c, @_);
550 my $self = bless { @_ }, $class;
552 $self->{path
} ||= [];
554 if ($self->{cache
}) {
555 mkdir $self->{cache
};
558 return $self->init();
567 Art5 - Template Toolkit
573 # creates a new object
574 my $art5 = Art5->new(path => \@path_to_templates);
576 # compiles and executes a string of Art5 code
577 my $r = $art5->process($source_code);
581 Artemus is a template toolkit. It filters text files, parsing, compiling
582 and executing code surrounded by special marks (leaving the rest
583 untouched) and concatenating everything as output. Its main purpose is
584 to filter HTML files, but it can be used for any scripting need related
585 to text filtering and substitution.
587 The main purpose of the Art5 API is to add your own functions to the
588 Art5 machine to make them part of the programming language. For more
589 information on the Art5 Templating Language, please see the included
590 L<art5_overview> document.
592 This can be done by adding code to the C<op> component of the Art5
593 object. For example, this is a way to add a C<localtime> function to
596 $art5->{op}->{localtime} = sub { return localtime(); };
598 Art5 functions can also accept arguments. They arrive as code streams
599 that must be executed before use. For example, this is a function that
600 accept two numbers and returns the average:
602 $art5->{op}->{avg} = sub {
606 return ($art5->exec($v1) + $art5->exec($v2)) / 2;
609 Art5 functions always have to return something. If you have nothing to
610 return, use an empty string. If an array must be returned (for example,
611 to be feed to C<foreach>, return a reference to it (not the array
614 The external hash can similarly accessed by tweaking the C<xh>
615 component. In this example, the running program process id will be
618 $art5->{xh}->{pid} = $!;
620 =head1 FUNCTIONS AND METHODS
627 [ path => \@directories, ]
628 [ cache => $directory, ]
629 [ loader_func => \&function, ]
632 Creates a new Art5 object. The object creation accepts the following
637 A reference to a list of directories where templates are to be found.
641 A directory path where compiled templates are to be cached. These compiled
642 templates are raw Data::Dumper output of the compiled stream, and are
643 loaded back with simple C<eval()>, so take B<extreme care>.
647 A pointer to a function to be called whenever a new template is queried
648 by the underlying system. This function should return the content of a
649 template or undef if not found. This mechanism is used to have an external
650 storage for templates (as in a SQL Database, for example). Take note that
651 templates retrived this way cannot be cached (this defect will eventually
654 This function is called before any search in the L<path>.
658 my $ret_val = $art->process($art5_code);
660 Compiles a string of Art5 code, executes it and returns the exit
665 my $opcode_stream = $art5->compile($art5_code);
667 Reads a string of Art5 code and returns a compiled stream.
671 my $ret_val = $art5->exec($opcode_stream);
673 Executes a compiled stream (returned by C<compile()>) and returns
678 Angel Ortega angel@triptico.com