Artemus.pm

   1 #####################################################################
   2 #
   3 #   Artemus - Template Toolkit
   4 #
   5 #   Copyright (C) 2000/2008 Angel Ortega <angel@triptico.com>
   6 #
   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.
  11 #
  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.
  16 #
  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.
  20 #
  21 #   http://triptico.com
  22 #
  23 #####################################################################
  24
  25 use locale;
  26
  27 package Artemus;
  28
  29 use strict;
  30 use warnings;
  31
  32 $Artemus::VERSION = '4.1.0-dev';
  33
  34 =pod
  35
  36 =head1 NAME
  37
  38 Artemus - Template Toolkit
  39
  40 =head1 SYNOPSIS
  41
  42  use Artemus;
  43
  44  # normal variables
  45  %vars = (
  46         "copyright" => 'Copyright 2002',   # normal variable
  47         "number" => 100,                   # another
  48         "about" => '{-copyright} My Self', # can be nested
  49         "link" => '<a href="$0">$1</a>'    # can accept parameters
  50         );
  51
  52  # functions as templates
  53  %funcs = (
  54         "rnd" => sub { int(rand(100)) },    # normal function
  55         "sqrt" => sub { sqrt($_[0]) }       # can accept parameters
  56         );
  57
  58  # create a new Artemus instance
  59  $ah = new Artemus( "vars" => \%vars, "funcs" => \%funcs );
  60
  61  # do it
  62  $out = $ah->process('Click on {-link|http://my.page|my page}, {-about}');
  63  $out2 = $ah->process('The square root of {-number} is {-sqrt|{-number}}');
  64
  65 =head1 DESCRIPTION
  66
  67 Artemus is yet another template toolkit. Though it was designed
  68 to preprocess HTML, it can be used for any task that involves
  69 text substitution. These templates can be plain text, text with
  70 parameters and hooks to real Perl code. This document describes
  71 the Artemus markup as well as the API.
  72
  73 You can download the latest version of this package and get
  74 more information from its home page at
  75
  76  http://triptico.com/software/artemus.html
  77
  78 =head1 THE ARTEMUS MARKUP
  79
  80 =head2 Simple templates
  81
  82 The simplest Artemus template is just a text substitution. If
  83 you set the 'about' template to '(C) 2000/2002 My Self', you
  84 can just write in your text
  85
  86  This software is {-about}.
  87
  88 and found it replaced by
  89
  90  This software is (C) 2000/2002 My Self.
  91
  92 Artemus templates can be nestable; so, if you set another
  93 template, called 'copyright' and containing '(C) 2000/2002', you
  94 can set 'about' to be '{-copyright} My Self', and obtain the
  95 same result. Though they can be nested nearly ad-infinitum, making
  96 circular references is unwise.
  97
  98 =head2 Templates with parameters
  99
 100 This wouldn't be any cool if templates where just text substitutions.
 101 But you can create templates that accept parameters just by including
 102 $0, $1, $2... marks inside its content. This marks will be replaced
 103 by the parameters used when inserting the call.
 104
 105 So, if you create the 'link' template containing
 106
 107  <a href = "$0">$1</a>
 108
 109 you can insert the following call:
 110
 111  {-link|http://triptico.com|Angel Ortega's Home Page}
 112
 113 As you can see, you use the | character as a separator
 114 among the parameters and the template name itself.
 115
 116 =head2 Perl functions as templates
 117
 118 Anything more complicated than this would require the definition
 119 of special functions provided by you. To do it, you just add
 120 templates to the 'funcs' hash reference when the Artemus object
 121 is created which values are references to Perl functions. For
 122 example, you can create a function returning a random value
 123 by using:
 124
 125  $funcs{'rnd'} = sub { int(rand(100)) };
 126
 127 And each time the {-random} template is found, it is evaluated
 128 and returns a random number between 0 and 99.
 129
 130 Functions also can accept parameters; so, if you define it as
 131
 132  $funcs{'rnd'} = sub { int(rand($_[0])) };
 133
 134 then calling the template as
 135
 136  {-rnd|500}
 137
 138 will return each time it's evaluated a random value between 0 and 499.
 139
 140 =head2 Aborting further execution from a function
 141
 142 If the I<abort-flag> argument is set to a scalar reference when creating
 143 the Artemus object, template processing can be aborted by setting
 144 this scalar to non-zero from inside a template function.
 145
 146 =head2 Caching templates
 147
 148 If a template is expensive or time consuming (probably because it
 149 calls several template functions that take very much time), it can be
 150 marked as cacheable. You must set the 'cache-path' argument for
 151 this to work, and include the following special Artemus code
 152 inside the template:
 153
 154  {-\CACHE|number}
 155
 156 where I<number> is a number of days (or fraction of day) the
 157 cache will remain cached before being re-evaluated. Individual
 158 template functions cannot be cached; you must wrap them in a
 159 normal template if need it.
 160
 161 =head2 Documenting templates
 162
 163 Artemus templates can contain documentation in Perl's POD format.
 164 This POD documentation is stripped each time the template is evaluated
 165 unless you create the Artemus object with the I<contains-pod> argument
 166 set.
 167
 168 See http://www.perldoc.com/perl5.8.0/pod/perlpod.html and
 169 http://www.perldoc.com/perl5.8.0/pod/perlpodspec.html for information
 170 about writing POD documentation.
 171
 172 =head2 Unresolved templates
 173
 174 If a template is not found, it will be replaced by its name (that is,
 175 stripped out of the {- and } and left there). Also, the names of the
 176 unresolved templates are appended to an array referenced by the
 177 I<unresolved> argument, if one was defined when the Artemus object
 178 was created.
 179
 180 =head2 Predefined templates
 181
 182 =over 4
 183
 184 =item B<if>
 185
 186  {-if|condition|text}
 187  {-if|condition|text_if_true|text_unless_true}
 188
 189 If I<condition> is true, this template returns I<text>, or nothing
 190 otherwise; in the 3 argument version, returns I<text_if_true> or
 191 I<text_unless_true>. A condition is true if is not zero or the empty
 192 string (the same as in Perl).
 193
 194 =item B<ifelse>
 195
 196 This is an alias for the I<if> template provided for backwards-compatibility.
 197 Don't use it.
 198
 199 =item B<ifeq>
 200
 201  {-ifeq|term1|term2|text}
 202  {-ifeq|term1|term2|text_if_true|text_unless_true}
 203
 204 If I<term1> is equal to I<term2>, this template returns I<text>, or nothing
 205 otherwise. in the 3 argument version, returns I<text_if_true> or
 206 I<text_unless_true>.
 207
 208 =item B<ifneq>
 209
 210  {-ifneq|term1|term2|text}
 211
 212 If I<term1> is not equal to I<term2>, this template returns I<text>, or
 213 nothing otherwise.
 214
 215 =item B<ifeqelse>
 216
 217 This is an alias for the I<ifeq> template provided for backwards-compatibility.
 218 Don't use it.
 219
 220 =item B<add>, B<sub>
 221
 222  {-add|num1|num2}
 223  {-sub|num1|num2}
 224
 225 This functions add or substract the values and returns the result.
 226
 227 =item B<gt>, B<lt>, B<eq>
 228
 229  {-gt|value1|value2}
 230  {-lt|value1|value2}
 231  {-eq|value1|value2}
 232
 233 This functions compare if I<value1> is greater-than, lesser-than or equal to
 234 I<value2>. Meant primarily to use with the I<if> template.
 235
 236 =item B<random>
 237
 238  {-random|value1|value2|...}
 239
 240 This function returns randomly one of the values sent as arguments. There can
 241 any number of arguments.
 242
 243 =item B<and>
 244
 245  {-and|value_or_condition_1|value_or_condition_2}
 246
 247 If both values are true or defined, returns I<value_or_condition_2>; otherwise,
 248 returns the empty string.
 249
 250 =item B<or>
 251
 252  {-or|value_or_condition_1|value_or_condition_2}
 253
 254 If I<value_or_condition_1> is true or defined, returns it; otherwise, if
 255 I<value_or_condition_2> is true or defined, returns it; otherwise, returns
 256 the empty string.
 257
 258 =item <not>
 259
 260  {-not|condition}
 261
 262 Returns the negation of I<condition>.
 263
 264 =item B<\CACHE>
 265
 266  {-\CACHE|time}
 267
 268 Marks a template as cacheable and sets its cache time. See above.
 269
 270 =item B<\VERSION>
 271
 272  {-\VERSION}
 273
 274 Returns current Artemus version.
 275
 276 =item B<\BEGIN>
 277
 278 =item B<\END>
 279
 280 If you set these templates, they will be appended (\BEGIN) and
 281 prepended (\END) to the text being processed.
 282
 283 =back
 284
 285 =head1 FUNCTIONS AND METHODS
 286
 287 =cut
 288
 289 =head2 B<new>
 290
 291  $ah = new Artemus(
 292         [ "vars" => \%variables, ]
 293         [ "funcs" => \%functions, ]
 294         [ "inv-vars" => \%inverse_variables, ]
 295         [ "include-path" => $dir_with_templates_in_files, ]
 296         [ "cache-path" => $dir_to_store_cached_templates, ]
 297         [ "abort-flag" => \$abort_flag, ]
 298         [ "unresolved" => \@unresolved_templates, ]
 299         [ "use-cr-lf" => $boolean, ]
 300         [ "contains-pod" => $boolean, ]
 301         [ "paragraph-separator" => $separator, ]
 302         [ "strip-html-comments" => $boolean, ]
 303         [ "AUTOLOAD" => \&autoload_func ]
 304         );
 305
 306 Creates a new Artemus object. The following arguments (passed to it
 307 as a hash) can be used:
 308
 309 =over 4
 310
 311 =item I<vars>
 312
 313 This argument must be a reference to a hash containing
 314 I<template> - I<content> pairs.
 315
 316 =item I<funcs>
 317
 318 This argument must be a reference to a hash containing
 319 I<template name> - I<code reference> pairs. Each time one of these
 320 templates is evaluated, the function will be called with
 321 the template parameters passed as the function's arguments.
 322
 323 =item I<inv-vars>
 324
 325 This argument must be a reference to a hash containing
 326 I<text> - I<content> pairs. Any occurrence of I<text> will be
 327 replaced by I<content>. They are called 'inverse variables'
 328 because they use to store variables that expand to Artemus
 329 markup, but can contain anything. This is really a plain
 330 text substitution, so use it with care (B<NOTE>: this
 331 option is disabled by now until it works correctly).
 332
 333 =item I<include-path>
 334
 335 If this string is set, it must point to a readable directory
 336 that contains templates, one on each file. The file names
 337 will be treated as template names. Many directories can
 338 be specified by separating them with colons.
 339
 340 =item I<cache-path>
 341
 342 If this string is set, it must contain the path to a readable
 343 and writable directory where the cacheable templates are cached.
 344 See L<Caching templates> for further information.
 345
 346 =item I<abort-flag>
 347
 348 This argument must be a reference to a scalar. When the template
 349 processing is started, this scalar is set to 0. Template functions
 350 can set it to any other non-zero value to stop template processing.
 351
 352 =item I<unresolved>
 353
 354 If this argument points to an array reference, it will be filled
 355 with the name of any unresolved templates. Each time a template
 356 processing is started, the array is emptied.
 357
 358 =item I<use-cr-lf>
 359
 360 If this flag is set, all lines are separated using CR/LF instead
 361 of just LF (useful to generate MSDOS/Windows compatible text files).
 362
 363 =item I<contains-pod>
 364
 365 If this flag is set, the (possible) POD documentation inside the
 366 templates are not stripped-out. Understand this flag as saying
 367 'this template has pod as part of its content, so do not strip it'.
 368 See L<Documenting templates>.
 369
 370 =item I<paragraph-separator>
 371
 372 If this argument is set to some string, all empty lines will be
 373 substituted by it (can be another Artemus template).
 374
 375 =item I<strip-html-comments>
 376
 377 If this flag is set, HTML comments are stripped before any
 378 processing.
 379
 380 =item I<AUTOLOAD>
 381
 382 If this argument points to a sub reference, the subrutine will
 383 be executed when a template is unresolved and its return value used
 384 as the final substitution value. Similar to the AUTOLOAD function
 385 in Perl standard modules. The unresolved template name will be
 386 sent as the first argument.
 387
 388 =back
 389
 390 =cut
 391
 392 sub new
 393 {
 394         my ($class, %params) = @_;
 395
 396         my $a = bless({ %params }, $class);
 397
 398         # special variables
 399         $a->{vars}->{'\n'}              = "\n";
 400         $a->{vars}->{'\BEGIN'}          ||= '';
 401         $a->{vars}->{'\END'}            ||= '';
 402         $a->{vars}->{'\VERSION'}        = $Artemus::VERSION;
 403
 404         # special functions
 405         $a->{funcs}->{localtime}        = sub { scalar(localtime) };
 406
 407         $a->{funcs}->{if}               = sub { $_[0] ? $_[1] : (scalar(@_) == 3 ? $_[2] : '') };
 408         $a->{funcs}->{ifelse}           = $a->{funcs}->{if};
 409
 410         $a->{funcs}->{ifeq}             = sub { $_[0] eq $_[1] ? $_[2] : (scalar(@_) == 4 ? $_[3] : '') };
 411         $a->{funcs}->{ifneq}            = sub { $_[0] ne $_[1] ? $_[2] : (scalar(@_) == 4 ? $_[3] : '') };
 412         $a->{funcs}->{ifeqelse}         = $a->{funcs}->{ifeq};
 413
 414         $a->{funcs}->{add}              = sub { $_[0] + $_[1]; };
 415         $a->{funcs}->{sub}              = sub { $_[0] - $_[1]; };
 416         $a->{funcs}->{gt}               = sub { $_[0] > $_[1]; };
 417         $a->{funcs}->{lt}               = sub { $_[0] < $_[1]; };
 418         $a->{funcs}->{eq}               = sub { $_[0] eq $_[1] ? 1 : 0; };
 419         $a->{funcs}->{random}           = sub { $_[rand(scalar(@_))]; };
 420
 421         $a->{funcs}->{and}              = sub { ($_[0] && $_[1]) || ''; };
 422         $a->{funcs}->{or}               = sub { $_[0] || $_[1] || ''; };
 423         $a->{funcs}->{not}              = sub { $_[0] ? 0 : 1; };
 424
 425         $a->{funcs}->{foreach}          = sub {
 426                 my $list        = shift;
 427                 my $code        = shift || '$0';
 428                 my $sep         = shift || '';
 429
 430                 my @ret = ();
 431                 my @l = split(/\s*:\s*/, $list);
 432
 433                 foreach my $l (@l) {
 434                         my @e = split(/\s*,\s*/, $l);
 435
 436                         push(@ret, $a->params($code, @e));
 437                 }
 438
 439                 return join($sep, @ret);
 440         };
 441
 442         $a->{funcs}->{set} = sub { $a->{vars}->{$_[0]} = $_[1]; return ''; };
 443
 444         return $a;
 445 }
 446
 447
 448 =head2 B<armor>
 449
 450  $str = $ah->armor($str);
 451
 452 Translate Artemus markup to HTML entities, to avoid being
 453 interpreted by the parser.
 454
 455 =cut
 456
 457 sub armor
 458 {
 459         my ($ah, $t) = @_;
 460
 461         $t =~ s/{/\&#123;/g;
 462         $t =~ s/\|/\&#124;/g;
 463         $t =~ s/}/\&#125;/g;
 464         $t =~ s/\$/\&#36;/g;
 465         $t =~ s/=/\&#61;/g;
 466
 467         return $t;
 468 }
 469
 470
 471 =head2 B<unarmor>
 472
 473  $str = $ah->unarmor($str);
 474
 475 Translate back the Artemus markup from HTML entities. This
 476 is the reverse operation of B<armor>.
 477
 478 =cut
 479
 480 sub unarmor
 481 {
 482         my ($ah, $t) = @_;
 483
 484         $t =~ s/\&#123;/{/g;
 485         $t =~ s/\&#124;/\|/g;
 486         $t =~ s/\&#125;/}/g;
 487         $t =~ s/\&#36;/\$/g;
 488         $t =~ s/\&#61;/=/g;
 489
 490         return $t;
 491 }
 492
 493
 494 =head2 B<strip>
 495
 496  $str = $ah->strip($str);
 497
 498 Strips all Artemus markup from the string.
 499
 500 =cut
 501
 502 sub strip
 503 {
 504         my ($ah, $t) = @_;
 505
 506         $t =~ s/{-([-\\\w_ \.]+)[^{}]*}/$1/g;
 507
 508         return $t;
 509 }
 510
 511
 512 =head2 B<params>
 513
 514  $str = $ah->params($str,@params);
 515
 516 Interpolates all $0, $1, $2... occurrences in the string into
 517 the equivalent element from @params.
 518
 519 =cut
 520
 521 sub params
 522 {
 523         my ($ah, $t, @params) = @_;
 524
 525         for(my $n = 0; $t =~ /\$$n/; $n++) {
 526                 $t =~ s/(^|[^\\])\$$n/$1$params[$n]/g;
 527         }
 528
 529         return $t;
 530 }
 531
 532
 533 =head2 B<process>
 534
 535  $str = $ah->process($str);
 536
 537 Processes the string, translating all Artemus markup. This
 538 is the main template processing method. The I<abort-flag> flag and
 539 I<unresolved> list are reset on each call to this method.
 540
 541 =cut
 542
 543 sub process
 544 {
 545         my ($ah, $data) = @_;
 546
 547         # not aborted by now
 548         if (ref ($ah->{'abort-flag'})) {
 549                 ${$ah->{'abort-flag'}} = 0;
 550         }
 551
 552         # no unresolved templates by now
 553         if (ref ($ah->{'unresolved'})) {
 554                 @{$ah->{'unresolved'}} = ();
 555         }
 556
 557         # surround with \BEGIN and \END
 558         $data = $ah->{'vars'}->{'\BEGIN'} . $data . $ah->{'vars'}->{'\END'};
 559
 560         # really do it, recursively
 561         $data = $ah->_process_do($data);
 562
 563         # finally, convert end of lines if necessary
 564         if ($ah->{'use-cr-lf'}) {
 565                 $data =~ s/\n/\r\n/g;
 566         }
 567
 568         # strip comments
 569         $data =~ s/{%[^}]+}//g;
 570
 571         return $data;
 572 }
 573
 574
 575 sub _process_do
 576 {
 577         my ($ah, $data, $template_name) = @_;
 578         my ($cache_time);
 579
 580         if ($ah->{debug}) {
 581                 print STDERR sprintf('Artemus: template="%s", data="%s"',
 582                         $template_name || 'NONE', $data || ''), "\n";
 583         }
 584
 585         # test if the template includes cache info
 586         if ($data =~ s/{-\\CACHE\W([^}]*)}//) {
 587                 if ($template_name and $ah->{'cache-path'}) {
 588                         $cache_time = $1;
 589
 590                         # convert strange chars to :
 591                         $template_name =~ s/[^\w\d_]/:/g;
 592
 593                         my ($f) = "$ah->{'cache-path'}/$template_name";
 594
 595                         if (-r $f and -M $f < $cache_time) {
 596                                 open F, $f;
 597                                 flock F, 1;
 598                                 $data = join('', <F>);
 599                                 close F;
 600
 601                                 return $data;
 602                         }
 603                 }
 604         }
 605
 606         # strip POD documentation, if any
 607         if ($data =~ /=cut/ and not $ah->{'contains-pod'}) {
 608                 my (@d);
 609
 610                 foreach (split("\n", $data)) {
 611                         unless (/^=/ .. /^=cut/) {
 612                                 push(@d, $_);
 613                         }
 614                 }
 615
 616                 $data = join("\n", @d);
 617         }
 618
 619         # strips HTML comments
 620         if ($ah->{'strip-html-comments'}) {
 621                 $data =~ s/<!--.*?-->//gs;
 622         }
 623
 624         # if defined, substitute the paragraphs
 625         # with the paragraph separator
 626         if ($ah->{'paragraph-separator'}) {
 627                 $data =~ s/\n\n/\n$ah->{'paragraph-separator'}\n/g;
 628         }
 629
 630         # inverse substitutions
 631         # (disabled until it works)
 632 #        while (my ($i, $v) = each(%{$ah->{'inv-vars'}})) {
 633 #                $data =~ s/\b$i\b/$v/g;
 634 #        }
 635
 636         # main function, variable and include substitutions
 637         while ($data =~ /{-([^{}\\]*(\\.[^{}\\]*)*)}/s) {
 638                 my ($found) = $1;
 639
 640                 # take key and params
 641                 my ($key, $params) = ($found =~ /^([-\\\w_]+)\|?(.*)$/s);
 642
 643                 # replace escaped chars
 644                 $params =~ s/\\{/{/g;
 645                 $params =~ s/\\}/}/g;
 646                 $params =~ s/\\\$/\$/g;
 647
 648                 # split parameters
 649                 my @params = ();
 650
 651                 while (length($params) && $params =~ s/^([^\|\\]*(\\.[^\|\\]*)*)\|?//s) {
 652                         my $p = $1;
 653                         $p =~ s/\\\|/\|/g;
 654
 655                         push(@params, $p);
 656                 }
 657
 658                 my $text = '';
 659
 660                 # is it a variable?
 661                 if (defined $ah->{'vars'}->{$key}) {
 662                         $text = $ah->{'vars'}->{$key};
 663                         $text = $ah->params($text, @params);
 664                 }
 665
 666                 # is it a function?
 667                 elsif (defined $ah->{'funcs'}->{$key}) {
 668                         my ($func);
 669
 670                         $func = $ah->{'funcs'}->{$key};
 671                         $text = $func->(@params);
 672
 673                         # functions can abort further execution
 674
 675                         if (ref($ah->{'abort-flag'}) and $$ah->{'abort-flag'}) {
 676                                 last;
 677                         }
 678                 }
 679
 680                 # is it an include?
 681                 elsif ($ah->{'include-path'}) {
 682                         foreach my $p (split(/:/, $ah->{'include-path'})) {
 683                                 if (open(INC, "$p/$key")) {
 684                                         $text = join('', <INC>);
 685                                         close INC;
 686
 687                                         # cache it as a variable
 688                                         $ah->{vars}->{$key} = $text;
 689
 690                                         $text = $ah->params($text, @params);
 691
 692                                         last;
 693                                 }
 694                         }
 695                 }
 696                 else {
 697                         $text = $found;
 698
 699                         if (ref $ah->{'unresolved'}) {
 700                                 push(@{$ah->{'unresolved'}}, $found);
 701                         }
 702
 703                         if (ref $ah->{'AUTOLOAD'}) {
 704                                 $text = $ah->{'AUTOLOAD'}($found);
 705                         }
 706                 }
 707
 708                 # do the recursivity
 709                 # if params are not to be cached,
 710                 # use $key instead of $found
 711                 $text = $ah->_process_do($text, $found);
 712
 713                 # make the substitution
 714                 $data =~ s/{-\Q$found\E}/$text/;
 715         }
 716
 717         # if the template included cache info,
 718         # store the result there
 719         if ($cache_time) {
 720                 open F, '>' . $ah->{'cache-path'} . '/' . $template_name;
 721                 flock F, 2;
 722                 print F $data;
 723                 close F;
 724         }
 725
 726         return $data;
 727 }
 728
 729
 730 =head1 AUTHOR
 731
 732 Angel Ortega angel@triptico.com
 733
 734 =cut
 735
 736 1;