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         "random" => 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{'random'} = 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{'random'} = sub { int(rand($_[0])) };
 133
 134 then calling the template as
 135
 136  {-random|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
 188 If I<condition> is true, this template returns I<text>, or nothing
 189 otherwise. A condition is true if is not zero or the empty string
 190 (the same as in Perl).
 191
 192 =item B<ifelse>
 193
 194  {-ifelse|condition|text_if_true|text_unless_true}
 195
 196 If I<condition> is true, this template returns I<text_if_true>, or
 197 I<text_unless_true> otherwise.
 198
 199 =item B<ifeq>
 200
 201  {-ifeq|term1|term2|text}
 202
 203 If I<term1> is equal to I<term2>, this template returns I<text>, or nothing
 204 otherwise.
 205
 206 =item B<ifneq>
 207
 208  {-ifneq|term1|term2|text}
 209
 210 If I<term1> is not equal to I<term2>, this template returns I<text>, or
 211 nothing otherwise.
 212
 213 =item B<ifeqelse>
 214
 215  {-ifeqelse|term1|term2|text_if_true|text_unless_true}
 216
 217 If I<term1> is equal to I<term2>, this template returns I<text_if_true>, or
 218 I<text_unless_true> otherwise.
 219
 220 =item B<\CACHE>
 221
 222  {-\CACHE|time}
 223
 224 Marks a template as cacheable and sets its cache time. See above.
 225
 226 =item B<\VERSION>
 227
 228  {-\VERSION}
 229
 230 Returns current Artemus version.
 231
 232 =item B<\BEGIN>
 233
 234 =item B<\END>
 235
 236 If you set these templates, they will be appended (\BEGIN) and
 237 prepended (\END) to the text being processed.
 238
 239 =back
 240
 241 =head1 FUNCTIONS AND METHODS
 242
 243 =cut
 244
 245 =head2 B<new>
 246
 247  $ah = new Artemus(
 248         [ "vars" => \%variables, ]
 249         [ "funcs" => \%functions, ]
 250         [ "inv-vars" => \%inverse_variables, ]
 251         [ "include-path" => $dir_with_templates_in_files, ]
 252         [ "cache-path" => $dir_to_store_cached_templates, ]
 253         [ "abort-flag" => \$abort_flag, ]
 254         [ "unresolved" => \@unresolved_templates, ]
 255         [ "use-cr-lf" => $boolean, ]
 256         [ "contains-pod" => $boolean, ]
 257         [ "paragraph-separator" => $separator, ]
 258         [ "strip-html-comments" => $boolean, ]
 259         [ "AUTOLOAD" => \&autoload_func ]
 260         );
 261
 262 Creates a new Artemus object. The following arguments (passed to it
 263 as a hash) can be used:
 264
 265 =over 4
 266
 267 =item I<vars>
 268
 269 This argument must be a reference to a hash containing
 270 I<template> - I<content> pairs.
 271
 272 =item I<funcs>
 273
 274 This argument must be a reference to a hash containing
 275 I<template name> - I<code reference> pairs. Each time one of these
 276 templates is evaluated, the function will be called with
 277 the template parameters passed as the function's arguments.
 278
 279 =item I<inv-vars>
 280
 281 This argument must be a reference to a hash containing
 282 I<text> - I<content> pairs. Any occurrence of I<text> will be
 283 replaced by I<content>. They are called 'inverse variables'
 284 because they use to store variables that expand to Artemus
 285 markup, but can contain anything. This is really a plain
 286 text substitution, so use it with care (B<NOTE>: this
 287 option is disabled by now until it works correctly).
 288
 289 =item I<include-path>
 290
 291 If this string is set, it must point to a readable directory
 292 that contains templates, one on each file. The file names
 293 will be treated as template names. Many directories can
 294 be specified by separating them with colons.
 295
 296 =item I<cache-path>
 297
 298 If this string is set, it must contain the path to a readable
 299 and writable directory where the cacheable templates are cached.
 300 See L<Caching templates> for further information.
 301
 302 =item I<abort-flag>
 303
 304 This argument must be a reference to a scalar. When the template
 305 processing is started, this scalar is set to 0. Template functions
 306 can set it to any other non-zero value to stop template processing.
 307
 308 =item I<unresolved>
 309
 310 If this argument points to an array reference, it will be filled
 311 with the name of any unresolved templates. Each time a template
 312 processing is started, the array is emptied.
 313
 314 =item I<use-cr-lf>
 315
 316 If this flag is set, all lines are separated using CR/LF instead
 317 of just LF (useful to generate MSDOS/Windows compatible text files).
 318
 319 =item I<contains-pod>
 320
 321 If this flag is set, the (possible) POD documentation inside the
 322 templates are not stripped-out. Understand this flag as saying
 323 'this template has pod as part of its content, so do not strip it'.
 324 See L<Documenting templates>.
 325
 326 =item I<paragraph-separator>
 327
 328 If this argument is set to some string, all empty lines will be
 329 substituted by it (can be another Artemus template).
 330
 331 =item I<strip-html-comments>
 332
 333 If this flag is set, HTML comments are stripped before any
 334 processing.
 335
 336 =item I<AUTOLOAD>
 337
 338 If this argument points to a sub reference, the subrutine will
 339 be executed when a template is unresolved and its return value used
 340 as the final substitution value. Similar to the AUTOLOAD function
 341 in Perl standard modules. The unresolved template name will be
 342 sent as the first argument.
 343
 344 =back
 345
 346 =cut
 347
 348 sub new
 349 {
 350         my ($class, %params) = @_;
 351
 352         my $a = bless({ %params }, $class);
 353
 354         # special variables
 355         $a->{vars}->{'\n'}              = "\n";
 356         $a->{vars}->{'\BEGIN'}  ||= '';
 357         $a->{vars}->{'\END'}            ||= '';
 358         $a->{vars}->{'\VERSION'}        = $Artemus::VERSION;
 359
 360         # special functions
 361         $a->{funcs}->{localtime}        = sub { scalar(localtime) };
 362         $a->{funcs}->{if}               = sub { $_[0] ? return $_[1] : return '' };
 363         $a->{funcs}->{ifelse}           = sub { $_[0] ? return $_[1] : return $_[2] };
 364         $a->{funcs}->{ifeq}             = sub { $_[0] eq $_[1] ? return $_[2] : return '' };
 365         $a->{funcs}->{ifneq}            = sub { $_[0] ne $_[1] ? return $_[2] : return '' };
 366         $a->{funcs}->{ifeqelse}         = sub { $_[0] eq $_[1] ? return $_[2] : return $_[3] };
 367
 368         $a->{funcs}->{foreach}          = sub {
 369                 my $list        = shift;
 370                 my $code        = shift || '$0';
 371                 my $sep         = shift || '';
 372
 373                 my @ret = ();
 374                 my @l = split(/\s*:\s*/, $list);
 375
 376                 foreach my $l (@l) {
 377                         my @e = split(/\s*,\s*/, $l);
 378
 379                         push(@ret, $a->params($code, @e));
 380                 }
 381
 382                 return join($sep, @ret);
 383         };
 384
 385         $a->{funcs}->{set} = sub { $a->{vars}->{$_[0]} = $_[1]; return ''; };
 386
 387         return $a;
 388 }
 389
 390
 391 =head2 B<armor>
 392
 393  $str = $ah->armor($str);
 394
 395 Translate Artemus markup to HTML entities, to avoid being
 396 interpreted by the parser.
 397
 398 =cut
 399
 400 sub armor
 401 {
 402         my ($ah, $t) = @_;
 403
 404         $t =~ s/{/\&#123;/g;
 405         $t =~ s/\|/\&#124;/g;
 406         $t =~ s/}/\&#125;/g;
 407         $t =~ s/\$/\&#36;/g;
 408         $t =~ s/=/\&#61;/g;
 409
 410         return $t;
 411 }
 412
 413
 414 =head2 B<unarmor>
 415
 416  $str = $ah->unarmor($str);
 417
 418 Translate back the Artemus markup from HTML entities. This
 419 is the reverse operation of B<armor>.
 420
 421 =cut
 422
 423 sub unarmor
 424 {
 425         my ($ah, $t) = @_;
 426
 427         $t =~ s/\&#123;/{/g;
 428         $t =~ s/\&#124;/\|/g;
 429         $t =~ s/\&#125;/}/g;
 430         $t =~ s/\&#36;/\$/g;
 431         $t =~ s/\&#61;/=/g;
 432
 433         return $t;
 434 }
 435
 436
 437 =head2 B<strip>
 438
 439  $str = $ah->strip($str);
 440
 441 Strips all Artemus markup from the string.
 442
 443 =cut
 444
 445 sub strip
 446 {
 447         my ($ah, $t) = @_;
 448
 449         $t =~ s/{-([-\\\w_ \.]+)[^{}]*}/$1/g;
 450
 451         return $t;
 452 }
 453
 454
 455 =head2 B<params>
 456
 457  $str = $ah->params($str,@params);
 458
 459 Interpolates all $0, $1, $2... occurrences in the string into
 460 the equivalent element from @params.
 461
 462 =cut
 463
 464 sub params
 465 {
 466         my ($ah, $t, @params) = @_;
 467
 468         for(my $n = 0; $t =~ /\$$n/; $n++) {
 469                 $t =~ s/(^|[^\\])\$$n/$1$params[$n]/g;
 470         }
 471
 472         return $t;
 473 }
 474
 475
 476 =head2 B<process>
 477
 478  $str = $ah->process($str);
 479
 480 Processes the string, translating all Artemus markup. This
 481 is the main template processing method. The I<abort-flag> flag and
 482 I<unresolved> list are reset on each call to this method.
 483
 484 =cut
 485
 486 sub process
 487 {
 488         my ($ah, $data) = @_;
 489
 490         # not aborted by now
 491         if (ref ($ah->{'abort-flag'})) {
 492                 ${$ah->{'abort-flag'}} = 0;
 493         }
 494
 495         # no unresolved templates by now
 496         if (ref ($ah->{'unresolved'})) {
 497                 @{$ah->{'unresolved'}} = ();
 498         }
 499
 500         # surround with \BEGIN and \END
 501         $data = $ah->{'vars'}->{'\BEGIN'} . $data . $ah->{'vars'}->{'\END'};
 502
 503         # really do it, recursively
 504         $data = $ah->_process_do($data);
 505
 506         # finally, convert end of lines if necessary
 507         if ($ah->{'use-cr-lf'}) {
 508                 $data =~ s/\n/\r\n/g;
 509         }
 510
 511         # strip comments
 512         $data =~ s/{%[^}]+}//g;
 513
 514         return $data;
 515 }
 516
 517
 518 sub _process_do
 519 {
 520         my ($ah, $data, $template_name) = @_;
 521         my ($cache_time);
 522
 523         if ($ah->{debug}) {
 524                 print STDERR sprintf('Artemus: template="%s", data="%s"',
 525                         $template_name || 'NONE', $data || ''), "\n";
 526         }
 527
 528         # test if the template includes cache info
 529         if ($data =~ s/{-\\CACHE\W([^}]*)}//) {
 530                 if ($template_name and $ah->{'cache-path'}) {
 531                         $cache_time = $1;
 532
 533                         # convert strange chars to :
 534                         $template_name =~ s/[^\w\d_]/:/g;
 535
 536                         my ($f) = "$ah->{'cache-path'}/$template_name";
 537
 538                         if (-r $f and -M $f < $cache_time) {
 539                                 open F, $f;
 540                                 flock F, 1;
 541                                 $data = join('', <F>);
 542                                 close F;
 543
 544                                 return $data;
 545                         }
 546                 }
 547         }
 548
 549         # strip POD documentation, if any
 550         if ($data =~ /=cut/ and not $ah->{'contains-pod'}) {
 551                 my (@d);
 552
 553                 foreach (split("\n", $data)) {
 554                         unless (/^=/ .. /^=cut/) {
 555                                 push(@d, $_);
 556                         }
 557                 }
 558
 559                 $data = join("\n", @d);
 560         }
 561
 562         # strips HTML comments
 563         if ($ah->{'strip-html-comments'}) {
 564                 $data =~ s/<!--.*?-->//gs;
 565         }
 566
 567         # if defined, substitute the paragraphs
 568         # with the paragraph separator
 569         if ($ah->{'paragraph-separator'}) {
 570                 $data =~ s/\n\n/\n$ah->{'paragraph-separator'}\n/g;
 571         }
 572
 573         # inverse substitutions
 574         # (disabled until it works)
 575 #        while (my ($i, $v) = each(%{$ah->{'inv-vars'}})) {
 576 #                $data =~ s/\b$i\b/$v/g;
 577 #        }
 578
 579         # main function, variable and include substitutions
 580         while ($data =~ /{-([^{}\\]*(\\.[^{}\\]*)*)}/s) {
 581                 my ($found) = $1;
 582
 583                 # take key and params
 584                 my ($key, $params) = ($found =~ /^([-\\\w_]+)\|?(.*)$/s);
 585
 586                 # replace escaped chars
 587                 $params =~ s/\\{/{/g;
 588                 $params =~ s/\\}/}/g;
 589                 $params =~ s/\\\$/\$/g;
 590
 591                 # split parameters
 592                 my @params = ();
 593
 594                 while ($params && $params =~ s/^([^\|\\]*(\\.[^\|\\]*)*)\|?//s) {
 595                         my $p = $1;
 596                         $p =~ s/\\\|/\|/g;
 597
 598                         push(@params, $p);
 599                 }
 600
 601                 my $text = undef;
 602
 603                 # is it a variable?
 604                 if (defined $ah->{'vars'}->{$key}) {
 605                         $text = $ah->{'vars'}->{$key};
 606                         $text = $ah->params($text, @params);
 607                 }
 608
 609                 # is it a function?
 610                 elsif (defined $ah->{'funcs'}->{$key}) {
 611                         my ($func);
 612
 613                         $func = $ah->{'funcs'}->{$key};
 614                         $text = $func->(@params);
 615
 616                         # functions can abort further execution
 617
 618                         if (ref($ah->{'abort-flag'}) and $$ah->{'abort-flag'}) {
 619                                 last;
 620                         }
 621                 }
 622
 623                 # is it an include?
 624                 elsif ($ah->{'include-path'}) {
 625                         foreach my $p (split(/:/, $ah->{'include-path'})) {
 626                                 if (open(INC, "$p/$key")) {
 627                                         $text = join('', <INC>);
 628                                         close INC;
 629
 630                                         # cache it as a variable
 631                                         $ah->{vars}->{$key} = $text;
 632
 633                                         $text = $ah->params($text, @params);
 634
 635                                         last;
 636                                 }
 637                         }
 638                 }
 639
 640                 unless (defined $text) {
 641                         $text = $found;
 642
 643                         if (ref $ah->{'unresolved'}) {
 644                                 push(@{$ah->{'unresolved'}}, $found);
 645                         }
 646
 647                         if (ref $ah->{'AUTOLOAD'}) {
 648                                 $text = $ah->{'AUTOLOAD'}($found);
 649                         }
 650                 }
 651
 652                 # do the recursivity
 653                 # if params are not to be cached,
 654                 # use $key instead of $found
 655                 $text = $ah->_process_do($text, $found);
 656
 657                 # make the substitution
 658                 $data =~ s/{-\Q$found\E}/$text/;
 659         }
 660
 661         # if the template included cache info,
 662         # store the result there
 663         if ($cache_time) {
 664                 open F, '>' . $ah->{'cache-path'} . '/' . $template_name;
 665                 flock F, 2;
 666                 print F $data;
 667                 close F;
 668         }
 669
 670         return $data;
 671 }
 672
 673
 674 =head1 AUTHOR
 675
 676 Angel Ortega angel@triptico.com
 677
 678 =cut
 679
 680 1;