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