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? build 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)
134 # was this code already compiled?
135 if (!exists($self->{pc
}->{$str})) {
139 # split by the Artemus5 marks
140 my @stream = split(/(<\{|\}>)/, $str);
142 # alternate between literal strings and Artemus5 code
144 my $p = shift(@stream);
147 $p = '{' . shift(@stream) . '}';
148 push(@ret, $self->parse(\
$p));
152 push(@ret, [ '"', $p ]);
158 $self->{pc
}->{$str} = $ret;
161 return $self->{pc
}->{$str};
169 if (!exists($self->{op
}->{$op})) {
172 # filter opcode to only allow
173 # characters valid in file names
174 $op =~ s/[^\w\d_-]//g;
176 # does a loader_func() exist?
177 if (ref($self->{loader_func
}) eq 'CODE') {
178 $src = $self->{loader_func
}->($op);
181 if (!defined($src)) {
182 # try to resolve by loading
183 # a source file from the path
184 foreach my $p (@
{$self->{path
}}) {
185 my $fp = $p . '/' . $op;
187 # does a precompiled script already exist?
188 if ($self->{cache
} && -f
$fp) {
189 my $cp = $self->{cache
} . $op;
191 if (-f
$cp && -M
$cp < -M
$fp) {
192 # it does and it's fresh; import wildly
193 $self->{op
}->{$op} = eval "require '$cp'";
200 $src = join('', <F
>);
208 # compile if available
210 $self->{op
}->{$op} = $self->compile($src);
212 # if there is a cache directory, save the compiled code
213 if ($self->{cache
} and open(F
, '>' . $self->{cache
} . $op)) {
216 print F Dumper
($self->{op
}->{$op});
222 return $self->{op
}->{$op};
231 if (ref($prg) && !$self->{abort
}) {
232 # if it has additonal arguments,
233 # wrap the call in a stack with them
235 push(@
{$self->{stack
}}, [ @_ ]);
237 $ret = $self->exec($prg);
239 pop(@
{$self->{stack
}});
242 # stream of Artemus5 code
243 my @stream = @
{$prg};
246 my $op = shift(@stream);
249 my $c = $self->code($op);
251 if (ref($c) eq 'CODE') {
252 $ret = $c->(@stream);
254 elsif (ref($c) eq 'ARRAY') {
257 map { $self->exec($_) } @stream
261 if ($self->code('AUTOLOAD')) {
262 $ret = $self->exec(['AUTOLOAD', [ '"', $op]]);
265 croak
"Artemus5 opcode not found: $op";
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 # template definition
342 $self->{op
}->{def
} = sub {
343 $self->{op
}->{$self->exec($_[0])} = $_[1];
348 # list of translation pairs
349 $self->{op
}->{'T'} = sub {
350 while (scalar(@_) > 1) {
351 my $k = $self->exec(shift);
352 my $v = $self->exec(shift);
354 $self->{t
}->{$k} = $v;
360 $self->{op
}->{eq} = sub {
361 $self->exec($_[0]) eq
362 $self->exec($_[1]) ?
1 : 0;
364 $self->{op
}->{ne} = sub {
365 $self->exec($_[0]) ne
366 $self->exec($_[1]) ?
1 : 0;
369 $self->{op
}->{and} = sub {
370 $self->exec($_[0]) && $self->exec($_[1]);
372 $self->{op
}->{or} = sub {
373 $self->exec($_[0]) || $self->exec($_[1]);
375 $self->{op
}->{not} = sub {
376 $self->exec($_[0]) ?
0 : 1;
379 $self->{op
}->{if} = sub {
382 if ($self->exec($_[0])) {
383 $ret = $self->exec($_[1]);
385 elsif (scalar(@_) == 3) {
386 $ret = $self->exec($_[2]);
392 $self->{op
}->{add
} = sub {
393 return $self->exec0($_[0]) + $self->exec0($_[1]);
395 $self->{op
}->{sub} = sub {
396 return $self->exec0($_[0]) - $self->exec0($_[1]);
398 $self->{op
}->{mul
} = sub {
399 return $self->exec0($_[0]) * $self->exec0($_[1]);
401 $self->{op
}->{div
} = sub {
402 return $self->exec0($_[0]) / $self->exec0($_[1]);
405 $self->{op
}->{gt} = sub {
406 return $self->exec0($_[0]) > $self->exec0($_[1]);
408 $self->{op
}->{lt} = sub {
409 return $self->exec0($_[0]) < $self->exec0($_[1]);
411 $self->{op
}->{random
} = sub {
412 return $self->exec($_[rand(scalar(@_))]);
415 $self->{op
}->{env
} = sub {
416 # no arguments? return keys as an arrayref
417 if (scalar(@_) == 0) {
418 return [ keys(%ENV) ];
421 return $ENV{$self->exec($_[0])};
424 $self->{op
}->{foreach} = sub {
426 my $code = shift || [ '$', 0 ];
427 my $sep = shift || [ '"', '' ];
428 my $header = shift || [ '"', '' ];
433 foreach my $e (@
{$self->exec($list)}) {
434 # create a stack for the elements
435 # and store the element in the stack
436 push(@
{$self->{stack
}}, ref($e) ?
$e : [ $e ]);
438 # execute the header code
439 my $o = $self->exec($header);
441 # if it's different from previous header,
442 # strip from output; otherwise, remember
451 # execute the body code
452 $o .= $self->exec($code);
457 pop(@
{$self->{stack
}});
460 return join($self->exec($sep), @ret);
463 $self->{op
}->{case
} = sub {
464 my $value = $self->exec(shift);
467 # if args are odd, the last one is
468 # the 'otherwise' case
469 if (scalar(@_) % 2) {
473 # now treat the rest of arguments as
474 # pairs of case / result
476 my $case = $self->exec(shift);
479 if ($value eq $case) {
480 return $self->exec($res);
484 return defined($oth) ?
$self->exec($oth) : '';
487 $self->{op
}->{seq
} = sub {
488 my $from = $self->exec0(shift);
489 my $to = $self->exec0(shift);
491 return [ $from .. $to ];
494 $self->{op
}->{sort} = sub {
495 my $list = $self->exec(shift);
496 my $code = shift || [ '$', 0 ];
498 # create a stack for the elements
499 push(@
{$self->{stack
}}, []);
502 $self->{stack
}->[-1] = ref($a) ?
$a : [ $a ];
503 my $va = $self->exec($code);
505 $self->{stack
}->[-1] = ref($b) ?
$b : [ $b ];
506 my $vb = $self->exec($code);
512 pop(@
{$self->{stack
}});
517 $self->{op
}->{reverse} = sub {
518 return [ reverse @
{$self->exec(shift)} ];
521 $self->{op
}->{size
} = sub { return scalar @
{$self->exec($_[0])} };
523 $self->{op
}->{split} = sub {
524 if (scalar(@_) == 3) {
525 return [ map { [ split($self->exec($_[1]), $_) ] }
526 split($self->exec($_[0]), $self->exec($_[2]))
529 return [ split($self->exec($_[0]), $self->exec($_[1])) ];
532 $self->{op
}->{dump} = sub {
535 return Dumper
($self->exec($_[0]));
538 $self->{xh
}->{arch
} = 'Unix';
548 my $c = $self->compile($src);
550 return $self->exec($c, @_);
557 my $self = bless { @_ }, $class;
559 $self->{path
} ||= [];
561 if ($self->{cache
}) {
562 mkdir $self->{cache
};
565 return $self->init();
574 Art5 - Template Toolkit
580 # creates a new object
581 my $art5 = Art5->new(path => \@path_to_templates);
583 # compiles and executes a string of Art5 code
584 my $r = $art5->process($source_code);
588 Artemus is a template toolkit. It filters text files, parsing, compiling
589 and executing code surrounded by special marks (leaving the rest
590 untouched) and concatenating everything as output. Its main purpose is
591 to filter HTML files, but it can be used for any scripting need related
592 to text filtering and substitution.
594 The main purpose of the Art5 API is to add your own functions to the
595 Art5 machine to make them part of the programming language. For more
596 information on the Art5 Templating Language, please see the included
597 L<art5_overview> document.
599 This can be done by adding code to the C<op> component of the Art5
600 object. For example, this is a way to add a C<localtime> function to
603 $art5->{op}->{localtime} = sub { return localtime(); };
605 Art5 functions can also accept arguments. They arrive as code streams
606 that must be executed before use. For example, this is a function that
607 accept two numbers and returns the average:
609 $art5->{op}->{avg} = sub {
613 return ($art5->exec($v1) + $art5->exec($v2)) / 2;
616 Art5 functions always have to return something. If you have nothing to
617 return, use an empty string. If an array must be returned (for example,
618 to be feed to C<foreach>, return a reference to it (not the array
621 The external hash can similarly accessed by tweaking the C<xh>
622 component. In this example, the running program process id will be
625 $art5->{xh}->{pid} = $!;
627 =head1 FUNCTIONS AND METHODS
634 [ path => \@directories, ]
635 [ cache => $directory, ]
636 [ loader_func => \&function, ]
639 Creates a new Art5 object. The object creation accepts the following
644 A reference to a list of directories where templates are to be found.
648 A directory path where compiled templates are to be cached. These compiled
649 templates are raw Data::Dumper output of the compiled stream, and are
650 loaded back with simple C<eval()>, so take B<extreme care>.
654 A pointer to a function to be called whenever a new template is queried
655 by the underlying system. This function should return the content of a
656 template or undef if not found. This mechanism is used to have an external
657 storage for templates (as in a SQL Database, for example). Take note that
658 templates retrived this way cannot be cached (this defect will eventually
661 This function is called before any search in the L<path>.
665 my $ret_val = $art->process($art5_code);
667 Compiles a string of Art5 code, executes it and returns the exit
672 my $opcode_stream = $art5->compile($art5_code);
674 Reads a string of Art5 code and returns a compiled stream.
678 my $ret_val = $art5->exec($opcode_stream);
680 Executes a compiled stream (returned by C<compile()>) and returns
685 Angel Ortega angel@triptico.com