File Coverage

blib/lib/HTML/Expander.pm

Criterion	Covered	Total	%
statement	124	156	79.4
branch	25	44	56.8
condition	27	39	69.2
subroutine	13	16	81.2
pod	0	11	0.0
total	189	266	71.0

#########################################################################
#
# HTML::Expander
# Vladi Belperchinov-Shabanski "Cade"
#
# http://cade.datamax.bg
#
#########################################################################
package HTML::Expander;
use Exporter;
@ISA     = qw( Exporter );

our $VERSION  = '2.7';

use Carp;
use strict;

#########################################################################

sub new
{
  my $pack = shift;
  my $class = ref( $pack ) || $pack;

  my $self = {};

  $self->{ 'TAGS'     } = {}; # tag tables
  $self->{ 'VARS'     } = {}; # var tables
  $self->{ 'INC'      } = {}; # include directories
  $self->{ 'ENV'      } = {}; # local environment, this is free for use

  $self->{ 'MODE'     } = []; # mode stack

  $self->{ 'WARNINGS' } = 0; # set to 1 for debug

  bless  $self, $class;
  return $self;
}

sub DESTROY
{
  my $self = shift;
  # nothing
}

sub define_tag
{
  my $self  = shift;

  confess "invalid arguments count, need MODENAME first" unless @_ % 2;

  my $mode  = shift || 'main';
  my %tags  = @_;

  $self->{ 'TAGS' }{ $mode } ||= {};
  %{ $self->{ 'TAGS' }{ $mode } } = ( %{ $self->{ 'TAGS' }{ $mode } }, %tags );
}

sub define_var
{
  my $self  = shift;

  confess "invalid arguments count, need MODENAME first" unless @_ % 2;

  my $mode  = shift || 'main';
  my %vars  = @_;

  $self->{ 'VARS' }{ $mode } ||= {};
  %{ $self->{ 'VARS' }{ $mode } } = ( %{ $self->{ 'VARS' }{ $mode } }, %vars );
}

sub add_inc_paths
{
  my $self  = shift;
  $self->{ 'INC' }{ $_ }++ for @_;
}

sub del_inc_paths
{
  my $self  = shift;
  delete $self->{ 'INC' }{ $_ } for @_;
}

sub mode_copy
{
  my $self  = shift;
  my $mode = shift; # destination mode

  for my $s ( @_ ) # for each source modes
    {
    # print "DEBUG: mode copy: [$mode] <- [$s]\n";
    while( my ( $k, $v ) = each %{ $self->{ 'TAGS' }{ $s } } )
      {
      # print "DEBUG:         TAG ($k) = ($v)\n";
      $self->define_tag( $mode, $k, $v );
      }
    while( my ( $k, $v ) = each %{ $self->{ 'VARS' }{ $s } } )
      {
      # print "DEBUG:         VAR ($k) = ($v)\n";
      $self->define_var( $mode, $k, $v );
      }
    }
}

sub mode_load
{
  my $self  = shift;
  my $file  = shift;

  my $target = 'main';
  open my $i, $file;
  while(<$i>)
    {
    next if /^\s*[#;]/; # comments
    chomp;
    if ( /^\s*MODE/i )
      {
      $_ = lc $_;
      s/\s+//g; # get rid of whitespace
      my @a = split /[:,]/;
      shift @a; # skip `mode' keyword
      $target = shift @a;
      $self->mode_copy( $target, @a );
      }
    else
      {
      $self->define_tag( $target, lc $1, $2 ) if /^\s*(<\S+)\s+(.*)$/;
      $self->define_var( $target, lc $2, $3 ) if /^\s*(%(\S+))\s+(.*)$/;
      }
    }
  close $i;
}

sub expand
{
  my $self  = shift;
  my $text  = shift;
  my $level = shift || 0;
  my $visited_arg = shift || {};

  my $visited = { %$visited_arg };

  #print "DEBUG: expand (level=$level) [text=$text]\n";

  $text =~ s/\(\%([^\(\)]+)\)/$self->expand_var( $1, $level+1, $visited )/gie;
  #print "DEBUG: ----------------------\n";
  $text =~ s/<([^<>]+)>/$self->expand_tag( $1, $level+1, $visited )/gie;
  #print "DEBUG: expand result: [text=$text]\n";
  return $text;
}

sub expand_var
{
  my $self    = shift;
  my $var     = shift;
  my $level   = shift;
  my $visited_arg = shift;

  my $visited = { %$visited_arg };

  return '***'.undef if $visited->{ "VAR::$var" }++; # avoids recursion
  my $mode = $self->{ 'MODE' }[0] || 'main';
  my $value =    $self->{ 'VARS' }{ $mode }{ $var }
              || $self->{ 'ENV' }{ $var };
  use Data::Dumper; # DEBUG
  print "DEBUG: expand_var: [$var] = ($value)\n".Dumper($visited)."\n";
  return $self->expand( $value, $level + 1, $visited );
}

sub expand_tag
{
  my $self    = shift;
  my $tag_org = shift;
  my $level   = shift;
  my $visited_arg = shift;

  my $visited = { %$visited_arg };

  my %args;
  my ( $tag, $args ) = split /\s+/, $tag_org, 2;
  # print "DEBUG: expand_tag: [$tag] -- ($args)\n";
  my $tag_lc = lc $tag;
  while( $args =~ /\s*([^=]+)(=('([^']*)'|"([^"]*)"|(\S*)))?/g ) # "' # fix string colorization
    {
    my $k = lc $1;
    my $v = $4 || $5 || $6 || 1;
    $args{ $k } = $v;
    # print "DEBUG:          [$k] = ($v)\n";
    }

  if ( $tag_lc eq 'mode' )
    {
    unshift @{ $self->{ 'MODE' } }, ( $args{ 'name' } || 'main' );
    $self->{ 'ENV' }{ '!MODE' } = $self->{ 'MODE' }[0] || 'main';
    return undef;
    }
  elsif ( $tag_lc eq '/mode' )
    {
    shift @{ $self->{ 'MODE' } };
    $self->{ 'ENV' }{ '!MODE' } = $self->{ 'MODE' }[0] || 'main';
    return undef;
    }
  if ( $tag_lc eq 'var' )
    {
    if( $args{ 'set' } eq '' )
      {
      return $self->expand_var( $args{ 'name' }, $level + 1, $visited );
      }
    else
      {
      $self->{ 'ENV' }{ uc $args{ 'name' } } = $args{ 'set' };
      return $args{ 'echo' } ? $args{ 'set' } : undef;
      }
    }
  elsif ( $tag_lc eq 'include' or $tag_lc eq 'inc' )
    {
    my $file_arg = $args{ 'file' };
    if( $file_arg !~ /^[a-zA-Z0-9_\-]+(\.[a-zA-Z0-9_\-]*)?$/ )
      {
      $self->warn( "forbidden include file name  `$file_arg'" );
      return undef
      }
    my $file;
    for( keys %{ $self->{ 'INC' } } )
      {
      $file = $_ . '/' . $file_arg;
      last if -e $file;
      $file = undef;
      }
    return undef if $visited->{ "INC::$file" }++; # avoids recursion
    open( my $i, $file ) || do
      {
      $self->warn( "cannot open file `$file'" );
      return undef;
      };
    my $data = $self->expand( join( '', <$i> ), $level + 1, $visited );
    close( $i );
    return $data;
    }
  elsif ( $tag_lc eq 'exec' )
    {
    my $cmd = $args{ 'cmd' };
    if( ! $self->{ 'EXEC_TAG_ALLOWED' } )
      {
      $self->warn( "exec is forbidden `$cmd'" );
      return undef;
      }

    open( my $i, $cmd . '|' ) || do
      {
      $self->warn( "exec failed `$cmd'" );
      return undef;
      };
    my $data = $self->expand( join( '', <$i> ), $level + 1, $visited );
    close $i;
    return $data;
    }
  else
    {
    $tag = "<$tag>";

    my $mode = $self->{ 'MODE' }[0] || 'main';
    my $value = $self->{ 'TAGS' }{ $mode }{ $tag };
    # print "DEBUG: mode name {$mode}, tag: $tag -> ($value)\n" if defined $value;
    if ( $value and ! $visited->{ "$mode::$tag" } )
      {
      # print "DEBUG:               ---> ($value)\n";
      $visited->{ "$mode::$tag" }++; # avoids recursion
      $value = $self->expand( $value, $level + 1, $visited );
      $value =~ s/\%([a-z_0-9]+)/$args{ lc $1 }/gi;
      my $ret = $self->expand( $value, $level + 1, $visited );
      # print "DEBUG: expand_tag return: [$ret]\n";
      return $ret;
      }
    else
      {
      # print "DEBUG: expand_tag original: [$tag_org]\n";
      return "<$tag_org>";
      }
    }
}

sub warn
{
  my $self = shift;
  return unless $self->{ 'WARNINGS' } || $self->{ 'WARN' };

  carp __PACKAGE__ . ": " . join( ' ', @_ );
}

=pod

=head1 NAME

HTML::Expander - html tag expander with inheritable tag definitions (modes)

=head1 SYNOPSIS

  use HTML::Expander;

  # get new HTML::Expander object;
  my $ex = new HTML::Expander;

  # load mode (tags) definitions
  $ex->mode_load( "/path/to/mode.def.txt" );

  # define some more tags
  $ex->define_tag( 'main', '',  '' );
  $ex->define_tag( 'main', '', '' );

  # copy `main' into `new' mode
  $ex->mode_copy( 'new', 'main' );

  # define one more tag
  $ex->define_tag( 'new', '',  '' );
  $ex->define_tag( 'new', '',  '' );
  $ex->define_tag( 'new', '',  '' );

  # expand!
  print $ex->expand( "
                        (current mode is '')
                        This is me

                        (current mode is '')
                        empty
                      1.
                      2.
                      3.
                      \n" );
  # the result will be:
  #                     (current mode is 'new')
  #                     This is me
  #
  #                     (cyrrent mode is 'main')
  #                     empty
  #                   1.
  #                   2.opala!
  #                   3.opala!

  # this should print current date
  $self->{ 'EXEC_TAG_ALLOWED' } = 1; # allow execution of programs
  print $ex->expand( '' ), "\n";
  $self->{ 'EXEC_TAG_ALLOWED' } = 0; # forbid execution of programs (default)

  # add include paths
  $ex->add_inc_paths( '/usr/html/inc', '/opt/test' );
  $ex->del_inc_paths( '.' );
  $ex->{ 'INC' }{ '.' } = 1;
  $ex->{ 'INC' }{ '/usr/html/inc' } = 1;
  $ex->{ 'INC' }{ '/opt/test' } = 1;

  # remove path
  delete $ex->{ 'INC' }{ '/usr/html/inc' };

  # include some file (avoiding recursion if required)
  print $ex->expand( '' ), "\n";

=head1 DESCRIPTION

HTML::Expander replaces html tags with other text (more tags, so it 'expands':))
with optional arguments. HTML::Expander uses tag tables which are called modes.
Modes can inherit other modes (several ones if needed). The goal is to have
as simple input html document as you need and have multiple different outputs.
For example you may want  tag to render either as  or as
 in two separated modes. 




366




 





 





 





 





 





 



   




367




 





 





 





 





 





 



 Essentially HTML::Expander works as preprocessor. 




368




 





 





 





 





 





 



   




369




 





 





 





 





 





 



 The mode file syntax is: 




370




 





 





 





 





 





 



   




371




 





 





 





 





 





 



   tag   tag-replacement-string 




372




 





 





 





 





 





 



   




373




 





 





 





 





 





 



   MODE: mode-name: inherited-modes-list 




374




 





 





 





 





 





 



   




375




 





 





 





 





 





 



   tag   tag-replacement-string 




376




 





 





 





 





 





 



   




377




 





 





 





 





 





 



   etc... 




378




 





 





 





 





 





 



   




379




 





 





 





 





 





 



 inherited-modes-list is comma or semicolon-separated list of modes that 




380




 





 





 





 





 





 



 should be copied (inherited) in this mode 




381




 





 





 





 





 





 



   




382




 





 





 





 





 





 



 The mode file example: 




383




 





 





 





 





 





 



   




384




 





 





 





 





 





 



   ### begin mode 




385




 





 





 





 





 





 



   




386




 





 





 





 





 





 



   # top-level mode is called `main' and is silently defined by default 




387




 





 





 





 





 





 



   # mode: main 




388




 





 





 





 





 





 



   




389




 





 





 





 





 





 



       




390




 





 





 





 





 





 



      




391




 





 





 





 





 





 



   




392




 





 





 





 





 





 



       




393




 





 





 





 





 





 



      




394




 





 





 





 





 





 



   




395




 





 





 





 





 





 



   MODE: page: main 




396




 





 





 





 





 





 



   




397




 





 





 





 





 





 



       




398




 





 





 





 





 





 



   




399




 





 





 





 





 





 



   MODE: edit: page, main 




400




 





 





 





 





 





 



   




401




 





 





 





 





 





 



   # actually `page' inherits `main' so it is not really 




402




 





 





 





 





 





 



   # required here to list `main' 




403




 





 





 





 





 





 



   




404




 





 





 





 





 





 



       




405




 





 





 





 





 





 



   




406




 





 





 





 





 





 



 This is not exhaustive example but it is just for example... 




407




 





 





 





 





 





 



   




408




 





 





 





 





 





 



 =head1 TAG ARGUMENTS 




409




 





 





 





 





 





 



   




410




 





 





 





 





 





 



 Inside the tag you can define arguments that can be used later during the 




411




 





 





 





 





 





 



 interpolation or as argument to the special tags etc. 




412




 





 





 





 





 





 



   




413




 





 





 





 





 





 



 Arguments cannot contain whitespace unless enclosed in " or ': 




414




 





 





 





 





 





 



   




415




 





 





 





 





 





 



                 # correct 




416




 





 





 





 





 





 



    # incorrect! 




417




 





 





 





 





 





 



      # correct 




418




 





 





 





 





 





 



    # correct 




419




 





 





 





 





 





 



   




420




 





 





 





 





 





 



 There is no way to mix " and ': 




421




 





 





 





 





 





 



   




422




 





 





 





 





 





 



    # incorrect! there is no escape syntax 




423




 





 





 





 





 





 



   




424




 





 





 





 





 





 



 You can have unary arguments (without value) which, if used, have '1' value. 




425




 





 





 





 





 





 



   




426




 





 





 





 





 





 



     is the same as  




427




 





 





 





 





 





 



   




428




 





 





 





 





 





 



 =head1 SPECIAL TAGS 




429




 





 





 





 





 





 



   




430




 





 





 





 





 





 



 There are several tags with special purposes: 




431




 





 





 





 





 





 



   




432




 





 





 





 





 





 



    




433




 





 





 





 





 





 



   




434




 





 





 





 





 





 



 Sets current mode to `name' (saves it on the top of the mode stack). 




435




 





 





 





 





 





 



   




436




 





 





 





 





 





 



    




437




 





 





 





 





 





 



   




438




 





 





 





 





 





 



 Removes last used mode from the stack (if stack is empty `main' is used). 




439




 





 





 





 





 





 



 Both  and  are replaced with empty strings. 




440




 





 





 





 





 





 



   




441




 





 





 





 





 





 



    




442




 





 





 





 





 





 



   




443




 





 





 





 





 





 



 This tag is replaced with `command's output. 'exec' is forbidden by default. 




444




 





 





 





 





 





 



 Using it will lead to empty string returned. To allow it you need to: 




445




 





 





 





 





 





 



   




446




 





 





 





 





 





 



   $ex->{ 'EXEC_TAG_ALLOWED' } = 1; # allow execution of programs 




447




 





 





 





 





 





 



   




448




 





 





 





 





 





 



 ($ex is the HTML::Expander object you want to allow execution) 




449




 





 





 





 





 





 



 exec must be used only if you produce html pages from static source, i.e. NOT 




450




 





 





 





 





 





 



 from end-user source like html forms etc.! To avoid unwanted execution the 




451




 





 





 





 





 





 



 program which uses HTML::Expander must encode all <>'s into html special 




452




 





 





 





 





 





 



 chars: 




453




 





 





 





 





 





 



   




454




 





 





 





 





 





 



   >   must be converted to   > 




455




 





 





 





 





 





 



   <   must be converted to   < 




456




 





 





 





 





 





 



   




457




 





 





 





 





 





 



 Rule of thumb is: do not use exec! :) 




458




 





 





 





 





 





 



   




459




 





 





 





 





 





 



    




460




 





 





 





 





 





 



   or 




461




 





 





 





 





 





 



    




462




 





 





 





 





 





 



   




463




 





 





 





 





 





 



 This tag is replaced with `incfile' file's content (which will be 




464




 





 





 





 





 





 



 HTML::Expanded recursively). 




465




 





 





 





 





 





 



   




466




 





 





 





 





 





 



 =head1 VARIABLES/ENVIRONMENT 




467




 





 





 





 





 





 



   




468




 





 





 





 





 





 



 HTML::Expander object have own 'environment' which is accessed this way: 




469




 





 





 





 





 





 



   




470




 





 





 





 





 





 



 $ex->{'ENV'}{ 'var-name' } = 'var-value'; 




471




 





 





 





 





 





 



   




472




 





 





 





 





 





 



 i.e. $ex->{'ENV'} is hash reference to the local environment. There is no 




473




 





 





 





 





 





 



 special access policy. 




474




 





 





 





 





 





 



   




475




 





 





 





 





 





 



 There is syntax for variables interpolation. Values are taken from internal 




476




 





 





 





 





 





 



 environment table: 




477




 





 





 





 





 





 



   




478




 





 





 





 





 





 



   (%VARNAME) 




479




 





 





 





 





 





 



   




480




 





 





 





 





 





 



 All variables are replaced before tag expansion! This helps to handle this: 




481




 





 





 





 





 





 



   




482




 





 





 





 





 





 



    




483




 





 





 





 





 





 



   




484




 





 





 





 





 





 



 If you need to interpolate variable in the tag expansion process (after the 




485




 





 





 





 





 





 



 variables interpolation) you need to: 




486




 





 





 





 





 





 



   




487




 





 





 





 





 





 



    




488




 





 





 





 





 





 



   




489




 





 





 





 





 





 



 If you need to set variable name during tag interpolation you should: 




490




 





 





 





 





 





 



   




491




 





 





 





 





 





 



    




492




 





 





 





 





 





 



   




493




 





 





 





 





 





 



 If you want to set variable and return its value at the same time you have to 




494




 





 





 





 





 





 



 use unary 'echo' argument: 




495




 





 





 





 





 





 



   




496




 





 





 





 





 





 



    




497




 





 





 





 





 





 



   




498




 





 





 





 





 





 



 (%VAR) variables are interpolated before %arg interpolation, so it is safe to 




499




 





 





 





 





 





 



 use this: 




500




 





 





 





 





 





 



   




501




 





 





 





 





 





 



    




502




 





 





 





 





 





 



   




503




 





 





 





 





 





 



 =head1 BUGS 




504




 





 





 





 





 





 



   




505




 





 





 





 





 





 



 Unknown tags are left as-is, this is not bug but if you write non-html tag 




506




 





 





 





 





 





 



 which is not defined in mode tables it will passed into the output text. 




507




 





 





 





 





 





 



 (see  example above for 'main' mode) 




508




 





 





 





 





 





 



   




509




 





 





 





 





 





 



 If you find bug please contact me, thank you. 




510




 





 





 





 





 





 



   




511




 





 





 





 





 





 



 =head1 DIAGNOSTICS 




512




 





 





 





 





 





 



   




513




 





 





 





 





 





 



 HTML::Expander can report warnings if something wrong is going on. This is 




514




 





 





 





 





 





 



 assumed to be debugging or diagnostic tool so it is disabled by default. 




515




 





 





 





 





 





 



 To enable warnings: 




516




 





 





 





 





 





 



   




517




 





 





 





 





 





 



   $ex->{ 'WARNINGS' } = 1; 




518




 





 





 





 





 





 



   




519




 





 





 





 





 





 



 =head1 TODO 




520




 





 





 





 





 





 



   




521




 





 





 





 





 





 



    




522




 





 





 





 





 





 



   




523




 





 





 





 





 





 



 =head1 AUTHOR 




524




 





 





 





 





 





 



   




525




 





 





 





 





 





 



   Vladi Belperchinov-Shabanski "Cade" 




526




 





 





 





 





 





 



   




527




 





 





 





 





 





 



      




528




 





 





 





 





 





 



   




529




 





 





 





 





 





 



   http://cade.datamax.bg 




530




 





 





 





 





 





 



   




531




 





 





 





 





 





 



 =head1 VERSION 




532




 





 





 





 





 





 



   




533




 





 





 





 





 





 



   $Id: Expander.pm,v 1.18 2006/04/30 00:30:00 cade Exp $ 




534




 





 





 





 





 





 



   




535




 





 





 





 





 





 



 =cut 




536




 





 





 





 





 





 



   




537




 





 





 





 





 





 



 ######################################################################### 




538




 





 





 





 





 





 



 #   eof 




539




 





 





 





 





 





 



 ######################################################################### 




540




 





 





 





 





 





 



 1;

Essentially HTML::Expander works as preprocessor.

The mode file syntax is:

  tag   tag-replacement-string

  MODE: mode-name: inherited-modes-list

  tag   tag-replacement-string

  etc...

inherited-modes-list is comma or semicolon-separated list of modes that
should be copied (inherited) in this mode

The mode file example:

  ### begin mode

  # top-level mode is called `main' and is silently defined by default
  # mode: main







  MODE: page: main



  MODE: edit: page, main

  # actually `page' inherits `main' so it is not really
  # required here to list `main'



This is not exhaustive example but it is just for example...

=head1 TAG ARGUMENTS

Inside the tag you can define arguments that can be used later during the
interpolation or as argument to the special tags etc.

Arguments cannot contain whitespace unless enclosed in " or ':

                # correct
   # incorrect!
     # correct
   # correct

There is no way to mix " and ':

   # incorrect! there is no escape syntax

You can have unary arguments (without value) which, if used, have '1' value.

    is the same as

=head1 SPECIAL TAGS

There are several tags with special purposes:



Sets current mode to `name' (saves it on the top of the mode stack).



Removes last used mode from the stack (if stack is empty `main' is used).
Both  and  are replaced with empty strings.



This tag is replaced with `command's output. 'exec' is forbidden by default.
Using it will lead to empty string returned. To allow it you need to:

  $ex->{ 'EXEC_TAG_ALLOWED' } = 1; # allow execution of programs

($ex is the HTML::Expander object you want to allow execution)
exec must be used only if you produce html pages from static source, i.e. NOT
from end-user source like html forms etc.! To avoid unwanted execution the
program which uses HTML::Expander must encode all <>'s into html special
chars:

  >   must be converted to   >
  <   must be converted to   <

Rule of thumb is: do not use exec! :)


  or


This tag is replaced with `incfile' file's content (which will be
HTML::Expanded recursively).

=head1 VARIABLES/ENVIRONMENT

HTML::Expander object have own 'environment' which is accessed this way:

$ex->{'ENV'}{ 'var-name' } = 'var-value';

i.e. $ex->{'ENV'} is hash reference to the local environment. There is no
special access policy.

There is syntax for variables interpolation. Values are taken from internal
environment table:

  (%VARNAME)

All variables are replaced before tag expansion! This helps to handle this:



If you need to interpolate variable in the tag expansion process (after the
variables interpolation) you need to:



If you need to set variable name during tag interpolation you should:



If you want to set variable and return its value at the same time you have to
use unary 'echo' argument:



(%VAR) variables are interpolated before %arg interpolation, so it is safe to
use this:



=head1 BUGS

Unknown tags are left as-is, this is not bug but if you write non-html tag
which is not defined in mode tables it will passed into the output text.
(see  example above for 'main' mode)

If you find bug please contact me, thank you.

=head1 DIAGNOSTICS

HTML::Expander can report warnings if something wrong is going on. This is
assumed to be debugging or diagnostic tool so it is disabled by default.
To enable warnings:

  $ex->{ 'WARNINGS' } = 1;

=head1 TODO



=head1 AUTHOR

  Vladi Belperchinov-Shabanski "Cade"



  http://cade.datamax.bg

=head1 VERSION

  $Id: Expander.pm,v 1.18 2006/04/30 00:30:00 cade Exp $

=cut

#########################################################################
#   eof
#########################################################################
1;