Projekt

Allgemein

Profil

Herunterladen (7,04 KB) Statistiken
| Zweig: | Markierung: | Revision:

kivitendo/SL/Template/Simple.pm @ 79b7fc43

0fba3edd Moritz Bunkus
#====================================================================
# 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;

0ffb94b4 Moritz Bunkus
use Scalar::Util qw(blessed);

0fba3edd Moritz Bunkus
# 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 {
7e0814bb Moritz Bunkus
my ($self, %params) = @_;
0fba3edd Moritz Bunkus
0b7d4ff9 Moritz Bunkus
$params{myconfig} ||= \%::myconfig;
$params{userspath} ||= $::lx_office_conf{paths}->{userspath};

7e0814bb Moritz Bunkus
$self->{$_} = $params{$_} for keys %params;
0fba3edd Moritz Bunkus
3e466ad1 Moritz Bunkus
$self->{variable_content_types} ||= {};
$self->{variable_content_types}->{$_} = lc $self->{variable_content_types}->{$_} for keys %{ $self->{variable_content_types} };
$self->{default_variable_content_type} = 'text';

0fba3edd Moritz Bunkus
$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;

29185b68 Sven Schöling
$self->{custom_tag_style} = 1;
0fba3edd Moritz Bunkus
$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}";
}

1b9d0f70 Sven Schöling
sub set_use_template_toolkit {
my $self = shift;
my $value = shift;

$self->{use_template_toolkit} = $value;
}

0fba3edd Moritz Bunkus
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 {
85629633 Sven Schöling
my ($self, $var, $get_array, @indices) = @_;
0fba3edd Moritz Bunkus
my $form = $self->{form};
85629633 Sven Schöling
my ($value, @methods);
0fba3edd Moritz Bunkus
0ffb94b4 Moritz Bunkus
if ($var =~ m/\./) {
85629633 Sven Schöling
($var, @methods) = split m/\./, $var;
}

if (($get_array || @indices) && (ref $form->{TEMPLATE_ARRAYS} eq 'HASH') && (ref $form->{TEMPLATE_ARRAYS}->{$var} eq 'ARRAY')) {
0fba3edd Moritz Bunkus
$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]];
}

85629633 Sven Schöling
for my $part (@methods) {
if (ref($value) =~ m/^(?:Form|HASH)$/) {
$value = $value->{$part};
} elsif (blessed($value) && $value->can($part)) {
$value = $value->$part;
} else {
$value = '';
last;
}
}

0fba3edd Moritz Bunkus
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]);
ac9bfb42 Moritz Bunkus
my ($var, @option_list) = split(/\s+/, $1);
my %options = map { ($_ => 1) } @option_list;
0fba3edd Moritz Bunkus
my $value = $self->_get_loop_variable($var, 0, @indices);
ac9bfb42 Moritz Bunkus
$value = $form->parse_amount({ numberformat => $::myconfig{output_numberformat} || $::myconfig{numberformat} }, $value) if $options{NOFORMAT};
3e466ad1 Moritz Bunkus
$value = $self->format_string($value, $var) unless $options{NOESCAPE};
0fba3edd Moritz Bunkus
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;
60c0c579 Moritz Bunkus
my $comparison = $3; # Optionaler Match um $4..$8
0fba3edd Moritz Bunkus
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;
60c0c579 Moritz Bunkus
($block, $$contents) = $self->find_end($$contents, 0, "$var $comparison", $not);
0fba3edd Moritz Bunkus
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);
c0abdaa6 Moritz Bunkus
$value = scalar(@{ $value }) if (ref($value) || '') eq 'ARRAY';
0fba3edd Moritz Bunkus
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;