Artemus.pm

   1 #####################################################################
   2 #
   3 #   Artemus - Template Toolkit
   4 #
   5 #   Copyright (C) 2000/2007 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://www.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://www.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://www.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
 375                 foreach my $l (split(/:/, $list)) {
 376                         my @e = split(/,/, $l);
 377
 378                         push(@ret, $a->params($code, @e));
 379                 }
 380
 381                 return join($sep, @ret);
 382         };
 383
 384         $a->{funcs}->{set} = sub { $a->{vars}->{$_[0]} = $_[1]; return ''; };
 385
 386         return $a;
 387 }
 388
 389
 390 =head2 B<armor>
 391
 392  $str = $ah->armor($str);
 393
 394 Translate Artemus markup to HTML entities, to avoid being
 395 interpreted by the parser.
 396
 397 =cut
 398
 399 sub armor
 400 {
 401         my ($ah, $t) = @_;
 402
 403         $t =~ s/{/\&#123;/g;
 404         $t =~ s/\|/\&#124;/g;
 405         $t =~ s/}/\&#125;/g;
 406         $t =~ s/\$/\&#36;/g;
 407         $t =~ s/=/\&#61;/g;
 408
 409         return $t;
 410 }
 411
 412
 413 =head2 B<unarmor>
 414
 415  $str = $ah->unarmor($str);
 416
 417 Translate back the Artemus markup from HTML entities. This
 418 is the reverse operation of B<armor>.
 419
 420 =cut
 421
 422 sub unarmor
 423 {
 424         my ($ah, $t) = @_;
 425
 426         $t =~ s/\&#123;/{/g;
 427         $t =~ s/\&#124;/\|/g;
 428         $t =~ s/\&#125;/}/g;
 429         $t =~ s/\&#36;/\$/g;
 430         $t =~ s/\&#61;/=/g;
 431
 432         return $t;
 433 }
 434
 435
 436 =head2 B<strip>
 437
 438  $str = $ah->strip($str);
 439
 440 Strips all Artemus markup from the string.
 441
 442 =cut
 443
 444 sub strip
 445 {
 446         my ($ah, $t) = @_;
 447
 448         $t =~ s/{-([-\\\w_ \.]+)[^{}]*}/$1/g;
 449
 450         return $t;
 451 }
 452
 453
 454 =head2 B<params>
 455
 456  $str = $ah->params($str,@params);
 457
 458 Interpolates all $0, $1, $2... occurrences in the string into
 459 the equivalent element from @params.
 460
 461 =cut
 462
 463 sub params
 464 {
 465         my ($ah, $t, @params) = @_;
 466
 467         for(my $n = 0; $t =~ /\$$n/; $n++) {
 468                 $t =~ s/(^|[^\\])\$$n/$1$params[$n]/g;
 469         }
 470
 471         return $t;
 472 }
 473
 474
 475 =head2 B<process>
 476
 477  $str = $ah->process($str);
 478
 479 Processes the string, translating all Artemus markup. This
 480 is the main template processing method. The I<abort-flag> flag and
 481 I<unresolved> list are reset on each call to this method.
 482
 483 =cut
 484
 485 sub process
 486 {
 487         my ($ah, $data) = @_;
 488
 489         # not aborted by now
 490         if (ref ($ah->{'abort-flag'})) {
 491                 ${$ah->{'abort-flag'}} = 0;
 492         }
 493
 494         # no unresolved templates by now
 495         if (ref ($ah->{'unresolved'})) {
 496                 @{$ah->{'unresolved'}} = ();
 497         }
 498
 499         # surround with \BEGIN and \END
 500         $data = $ah->{'vars'}->{'\BEGIN'} . $data . $ah->{'vars'}->{'\END'};
 501
 502         # really do it, recursively
 503         $data = $ah->_process_do($data);
 504
 505         # finally, convert end of lines if necessary
 506         if ($ah->{'use-cr-lf'}) {
 507                 $data =~ s/\n/\r\n/g;
 508         }
 509
 510         # strip comments
 511         $data =~ s/{%[^}]+}//g;
 512
 513         return $data;
 514 }
 515
 516
 517 sub _process_do
 518 {
 519         my ($ah, $data, $template_name) = @_;
 520         my ($cache_time);
 521
 522         if ($ah->{debug}) {
 523                 print STDERR sprintf('Artemus: template="%s", data="%s"',
 524                         $template_name || 'NONE', $data || ''), "\n";
 525         }
 526
 527         # test if the template includes cache info
 528         if ($data =~ s/{-\\CACHE\W([^}]*)}//) {
 529                 if ($template_name and $ah->{'cache-path'}) {
 530                         $cache_time = $1;
 531
 532                         # convert strange chars to :
 533                         $template_name =~ s/[^\w\d_]/:/g;
 534
 535                         my ($f) = "$ah->{'cache-path'}/$template_name";
 536
 537                         if (-r $f and -M $f < $cache_time) {
 538                                 open F, $f;
 539                                 flock F, 1;
 540                                 $data = join('', <F>);
 541                                 close F;
 542
 543                                 return $data;
 544                         }
 545                 }
 546         }
 547
 548         # strip POD documentation, if any
 549         if ($data =~ /=cut/ and not $ah->{'contains-pod'}) {
 550                 my (@d);
 551
 552                 foreach (split("\n", $data)) {
 553                         unless (/^=/ .. /^=cut/) {
 554                                 push(@d, $_);
 555                         }
 556                 }
 557
 558                 $data = join("\n", @d);
 559         }
 560
 561         # strips HTML comments
 562         if ($ah->{'strip-html-comments'}) {
 563                 $data =~ s/<!--.*?-->//gs;
 564         }
 565
 566         # if defined, substitute the paragraphs
 567         # with the paragraph separator
 568         if ($ah->{'paragraph-separator'}) {
 569                 $data =~ s/\n\n/\n$ah->{'paragraph-separator'}\n/g;
 570         }
 571
 572         # inverse substitutions
 573         # (disabled until it works)
 574 #        while (my ($i, $v) = each(%{$ah->{'inv-vars'}})) {
 575 #                $data =~ s/\b$i\b/$v/g;
 576 #        }
 577
 578         # main function, variable and include substitutions
 579         while ($data =~ /{-([^{}\\]*(\\.[^{}\\]*)*)}/s) {
 580                 my ($found) = $1;
 581
 582                 # take key and params
 583                 my ($key, $params) = ($found =~ /^([-\\\w_]+)\|?(.*)$/s);
 584
 585                 # replace escaped chars
 586                 $params =~ s/\\{/{/g;
 587                 $params =~ s/\\}/}/g;
 588                 $params =~ s/\\\$/\$/g;
 589
 590                 # split parameters
 591                 my @params = ();
 592
 593                 while ($params && $params =~ s/^([^\|\\]*(\\.[^\|\\]*)*)\|?//s) {
 594                         my $p = $1;
 595                         $p =~ s/\\\|/\|/g;
 596
 597                         push(@params, $p);
 598                 }
 599
 600                 my $text = undef;
 601
 602                 # is it a variable?
 603                 if (defined $ah->{'vars'}->{$key}) {
 604                         $text = $ah->{'vars'}->{$key};
 605                         $text = $ah->params($text, @params);
 606                 }
 607
 608                 # is it a function?
 609                 elsif (defined $ah->{'funcs'}->{$key}) {
 610                         my ($func);
 611
 612                         $func = $ah->{'funcs'}->{$key};
 613                         $text = $func->(@params);
 614
 615                         # functions can abort further execution
 616
 617                         if (ref($ah->{'abort-flag'}) and $$ah->{'abort-flag'}) {
 618                                 last;
 619                         }
 620                 }
 621
 622                 # is it an include?
 623                 elsif ($ah->{'include-path'}) {
 624                         foreach my $p (split(/:/, $ah->{'include-path'})) {
 625                                 if (open(INC, "$p/$key")) {
 626                                         $text = join('', <INC>);
 627                                         close INC;
 628
 629                                         # cache it as a variable
 630                                         $ah->{vars}->{$key} = $text;
 631
 632                                         $text = $ah->params($text, @params);
 633
 634                                         last;
 635                                 }
 636                         }
 637                 }
 638
 639                 unless (defined $text) {
 640                         $text = $found;
 641
 642                         if (ref $ah->{'unresolved'}) {
 643                                 push(@{$ah->{'unresolved'}}, $found);
 644                         }
 645
 646                         if (ref $ah->{'AUTOLOAD'}) {
 647                                 $text = $ah->{'AUTOLOAD'}($found);
 648                         }
 649                 }
 650
 651                 # do the recursivity
 652                 # if params are not to be cached,
 653                 # use $key instead of $found
 654                 $text = $ah->_process_do($text, $found);
 655
 656                 # make the substitution
 657                 $data =~ s/{-\Q$found\E}/$text/;
 658         }
 659
 660         # if the template included cache info,
 661         # store the result there
 662         if ($cache_time) {
 663                 open F, '>' . $ah->{'cache-path'} . '/' . $template_name;
 664                 flock F, 2;
 665                 print F $data;
 666                 close F;
 667         }
 668
 669         return $data;
 670 }
 671
 672
 673 =head1 AUTHOR
 674
 675 Angel Ortega angel@triptico.com
 676
 677 =cut
 678
 679 1;