|
#====================================================================
|
|
# LX-Office ERP
|
|
# Copyright (C) 2004
|
|
# Based on SQL-Ledger Version 2.1.9
|
|
# Web http://www.lx-office.org
|
|
#
|
|
#====================================================================
|
|
|
|
package SL::Template::Simple;
|
|
|
|
use strict;
|
|
|
|
# Parameters:
|
|
# 1. The template's file name
|
|
# 2. A reference to the Form object
|
|
# 3. A reference to the myconfig hash
|
|
#
|
|
# Returns:
|
|
# A new template object
|
|
sub new {
|
|
my $type = shift;
|
|
my $self = {};
|
|
|
|
bless($self, $type);
|
|
$self->_init(@_);
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub _init {
|
|
my $self = shift;
|
|
|
|
$self->{source} = shift;
|
|
$self->{form} = shift;
|
|
$self->{myconfig} = shift;
|
|
$self->{userspath} = shift;
|
|
|
|
$self->{error} = undef;
|
|
$self->{quot_re} = '"';
|
|
|
|
$self->set_tag_style('<%', '%>');
|
|
}
|
|
|
|
sub set_tag_style {
|
|
my $self = shift;
|
|
my $tag_start = shift;
|
|
my $tag_end = shift;
|
|
|
|
$self->{tag_start} = $tag_start;
|
|
$self->{tag_end} = $tag_end;
|
|
$self->{tag_start_qm} = quotemeta $tag_start;
|
|
$self->{tag_end_qm} = quotemeta $tag_end;
|
|
|
|
$self->{substitute_vars_re} = "$self->{tag_start_qm}(.+?)$self->{tag_end_qm}";
|
|
}
|
|
|
|
sub cleanup {
|
|
my ($self) = @_;
|
|
}
|
|
|
|
# Parameters:
|
|
# 1. A typeglob for the file handle. The output will be written
|
|
# to this file handle.
|
|
#
|
|
# Returns:
|
|
# 1 on success and undef or 0 if there was an error. In the latter case
|
|
# the calling function can retrieve the error message via $obj->get_error()
|
|
sub parse {
|
|
my $self = $_[0];
|
|
local *OUT = $_[1];
|
|
|
|
print(OUT "Hallo!\n");
|
|
}
|
|
|
|
sub get_error {
|
|
my $self = shift;
|
|
|
|
return $self->{"error"};
|
|
}
|
|
|
|
sub uses_temp_file {
|
|
return 0;
|
|
}
|
|
|
|
sub _get_loop_variable {
|
|
my $self = shift;
|
|
my $var = shift;
|
|
my $get_array = shift;
|
|
my @indices = @_;
|
|
|
|
my $form = $self->{form};
|
|
my $value;
|
|
|
|
if (($get_array || @indices) && (ref $form->{TEMPLATE_ARRAYS} eq 'HASH') && (ref $form->{TEMPLATE_ARRAYS}->{$var} eq 'ARRAY')) {
|
|
$value = $form->{TEMPLATE_ARRAYS}->{$var};
|
|
} else {
|
|
$value = $form->{$var};
|
|
}
|
|
|
|
for (my $i = 0; $i < scalar(@indices); $i++) {
|
|
last unless (ref($value) eq "ARRAY");
|
|
$value = $value->[$indices[$i]];
|
|
}
|
|
|
|
return $value;
|
|
}
|
|
|
|
sub substitute_vars {
|
|
my ($self, $text, @indices) = @_;
|
|
|
|
my $form = $self->{"form"};
|
|
|
|
while ($text =~ /$self->{substitute_vars_re}/) {
|
|
my ($tag_pos, $tag_len) = ($-[0], $+[0] - $-[0]);
|
|
my ($var, @options) = split(/\s+/, $1);
|
|
|
|
my $value = $self->_get_loop_variable($var, 0, @indices);
|
|
$value = $self->format_string($value) unless (grep(/^NOESCAPE$/, @options));
|
|
|
|
substr($text, $tag_pos, $tag_len, $value);
|
|
}
|
|
|
|
return $text;
|
|
}
|
|
|
|
sub _parse_block_if {
|
|
$main::lxdebug->enter_sub();
|
|
|
|
my $self = shift;
|
|
my $contents = shift;
|
|
my $new_contents = shift;
|
|
my $pos_if = shift;
|
|
my @indices = @_;
|
|
|
|
$$new_contents .= $self->substitute_vars(substr($$contents, 0, $pos_if), @indices);
|
|
substr($$contents, 0, $pos_if) = "";
|
|
|
|
if ($$contents !~ m/^$self->{tag_start_qm}if
|
|
\s*
|
|
(not\b|\!)? # $1 -- Eventuelle Negierung
|
|
\s+
|
|
(\b.+?\b) # $2 -- Name der zu überprüfenden Variablen
|
|
( # $3 -- Beginn des optionalen Vergleiches
|
|
\s*
|
|
([!=]) # $4 -- Negierung des Vergleiches speichern
|
|
([=~]) # $5 -- Art des Vergleiches speichern
|
|
\s*
|
|
( # $6 -- Gequoteter String oder Bareword
|
|
$self->{quot_re}
|
|
(.*?)(?<!\\) # $7 -- Gequoteter String -- direkter Vergleich mit eq bzw. ne oder Patternmatching; Escapete Anführungs als Teil des Strings belassen
|
|
$self->{quot_re}
|
|
|
|
|
(\b.+?\b) # $8 -- Bareword -- als Index für $form benutzen
|
|
)
|
|
)?
|
|
\s*
|
|
$self->{tag_end_qm}
|
|
/x) {
|
|
$self->{"error"} = "Malformed $self->{tag_start}if$self->{tag_end}.";
|
|
$main::lxdebug->leave_sub();
|
|
return undef;
|
|
}
|
|
|
|
my $not = $1;
|
|
my $var = $2;
|
|
my $comparison = $3; # Optionaler Match um $4..$8
|
|
my $operator_neg = $4; # '=' oder '!' oder undef, wenn kein Vergleich erkannt
|
|
my $operator_type = $5; # '=' oder '~' für Stringvergleich oder Regex
|
|
my $quoted_word = $7; # nur gültig, wenn quoted string angegeben (siehe unten); dann "value" aus <%if var == "value" %>
|
|
my $bareword = $8; # undef, falls quoted string angegeben wurde; andernfalls "othervar" aus <%if var == othervar %>
|
|
|
|
$not = !$not if ($operator_neg && $operator_neg eq '!');
|
|
|
|
substr($$contents, 0, length($&)) = "";
|
|
|
|
my $block;
|
|
($block, $$contents) = $self->find_end($$contents, 0, "$var $comparison", $not);
|
|
if (!$block) {
|
|
$self->{"error"} = "Unclosed $self->{tag_start}if$self->{tag_end}." unless ($self->{"error"});
|
|
$main::lxdebug->leave_sub();
|
|
return undef;
|
|
}
|
|
|
|
my $value = $self->_get_loop_variable($var, 0, @indices);
|
|
my $hit = 0;
|
|
|
|
if ($operator_type) {
|
|
my $compare_to = $bareword ? $self->_get_loop_variable($bareword, 0, @indices) : $quoted_word;
|
|
if ($operator_type eq '=') {
|
|
$hit = ($not && !($value eq $compare_to)) || (!$not && ($value eq $compare_to));
|
|
} else {
|
|
$hit = ($not && !($value =~ m/$compare_to/i)) || (!$not && ($value =~ m/$compare_to/i));
|
|
}
|
|
|
|
} else {
|
|
$hit = ($not && ! $value) || (!$not && $value);
|
|
}
|
|
|
|
if ($hit) {
|
|
my $new_text = $self->parse_block($block, @indices);
|
|
if (!defined($new_text)) {
|
|
$main::lxdebug->leave_sub();
|
|
return undef;
|
|
}
|
|
$$new_contents .= $new_text;
|
|
}
|
|
|
|
$main::lxdebug->leave_sub();
|
|
|
|
return 1;
|
|
}
|
|
|
|
1;
|