1 #====================================================================
4 # Based on SQL-Ledger Version 2.1.9
5 # Web http://www.lx-office.org
7 #====================================================================
9 package SL::Template::Simple;
13 use Scalar::Util qw(blessed);
16 # 1. The template's file name
17 # 2. A reference to the Form object
18 # 3. A reference to the myconfig hash
21 # A new template object
35 $self->{source} = shift;
36 $self->{form} = shift;
37 $self->{myconfig} = shift;
38 $self->{userspath} = shift;
40 $self->{error} = undef;
41 $self->{quot_re} = '"';
43 $self->set_tag_style('<%', '%>');
48 my $tag_start = shift;
51 $self->{tag_start} = $tag_start;
52 $self->{tag_end} = $tag_end;
53 $self->{tag_start_qm} = quotemeta $tag_start;
54 $self->{tag_end_qm} = quotemeta $tag_end;
56 $self->{substitute_vars_re} = "$self->{tag_start_qm}(.+?)$self->{tag_end_qm}";
59 sub set_use_template_toolkit {
63 $self->{use_template_toolkit} = $value;
71 # 1. A typeglob for the file handle. The output will be written
72 # to this file handle.
75 # 1 on success and undef or 0 if there was an error. In the latter case
76 # the calling function can retrieve the error message via $obj->get_error()
81 print(OUT "Hallo!\n");
87 return $self->{"error"};
94 sub _get_loop_variable {
95 my ($self, $var, $get_array, @indices) = @_;
96 my $form = $self->{form};
97 my ($value, @methods);
100 ($var, @methods) = split m/\./, $var;
103 if (($get_array || @indices) && (ref $form->{TEMPLATE_ARRAYS} eq 'HASH') && (ref $form->{TEMPLATE_ARRAYS}->{$var} eq 'ARRAY')) {
104 $value = $form->{TEMPLATE_ARRAYS}->{$var};
106 $value = $form->{$var};
109 for (my $i = 0; $i < scalar(@indices); $i++) {
110 last unless (ref($value) eq "ARRAY");
111 $value = $value->[$indices[$i]];
114 for my $part (@methods) {
115 if (ref($value) =~ m/^(?:Form|HASH)$/) {
116 $value = $value->{$part};
117 } elsif (blessed($value) && $value->can($part)) {
118 $value = $value->$part;
128 sub substitute_vars {
129 my ($self, $text, @indices) = @_;
131 my $form = $self->{"form"};
133 while ($text =~ /$self->{substitute_vars_re}/) {
134 my ($tag_pos, $tag_len) = ($-[0], $+[0] - $-[0]);
135 my ($var, @option_list) = split(/\s+/, $1);
136 my %options = map { ($_ => 1) } @option_list;
138 my $value = $self->_get_loop_variable($var, 0, @indices);
139 $value = $form->parse_amount({ numberformat => $::myconfig{output_numberformat} || $::myconfig{numberformat} }, $value) if $options{NOFORMAT};
140 $value = $self->format_string($value) unless $options{NOESCAPE};
142 substr($text, $tag_pos, $tag_len, $value);
148 sub _parse_block_if {
149 $main::lxdebug->enter_sub();
152 my $contents = shift;
153 my $new_contents = shift;
157 $$new_contents .= $self->substitute_vars(substr($$contents, 0, $pos_if), @indices);
158 substr($$contents, 0, $pos_if) = "";
160 if ($$contents !~ m/^$self->{tag_start_qm}if
162 (not\b|\!)? # $1 -- Eventuelle Negierung
164 (\b.+?\b) # $2 -- Name der zu überprüfenden Variablen
165 ( # $3 -- Beginn des optionalen Vergleiches
167 ([!=]) # $4 -- Negierung des Vergleiches speichern
168 ([=~]) # $5 -- Art des Vergleiches speichern
170 ( # $6 -- Gequoteter String oder Bareword
172 (.*?)(?<!\\) # $7 -- Gequoteter String -- direkter Vergleich mit eq bzw. ne oder Patternmatching; Escapete Anführungs als Teil des Strings belassen
175 (\b.+?\b) # $8 -- Bareword -- als Index für $form benutzen
181 $self->{"error"} = "Malformed $self->{tag_start}if$self->{tag_end}.";
182 $main::lxdebug->leave_sub();
188 my $comparison = $3; # Optionaler Match um $4..$8
189 my $operator_neg = $4; # '=' oder '!' oder undef, wenn kein Vergleich erkannt
190 my $operator_type = $5; # '=' oder '~' für Stringvergleich oder Regex
191 my $quoted_word = $7; # nur gültig, wenn quoted string angegeben (siehe unten); dann "value" aus <%if var == "value" %>
192 my $bareword = $8; # undef, falls quoted string angegeben wurde; andernfalls "othervar" aus <%if var == othervar %>
194 $not = !$not if ($operator_neg && $operator_neg eq '!');
196 substr($$contents, 0, length($&)) = "";
199 ($block, $$contents) = $self->find_end($$contents, 0, "$var $comparison", $not);
201 $self->{"error"} = "Unclosed $self->{tag_start}if$self->{tag_end}." unless ($self->{"error"});
202 $main::lxdebug->leave_sub();
206 my $value = $self->_get_loop_variable($var, 0, @indices);
207 $value = scalar(@{ $value }) if (ref($value) || '') eq 'ARRAY';
210 if ($operator_type) {
211 my $compare_to = $bareword ? $self->_get_loop_variable($bareword, 0, @indices) : $quoted_word;
212 if ($operator_type eq '=') {
213 $hit = ($not && !($value eq $compare_to)) || (!$not && ($value eq $compare_to));
215 $hit = ($not && !($value =~ m/$compare_to/i)) || (!$not && ($value =~ m/$compare_to/i));
219 $hit = ($not && ! $value) || (!$not && $value);
223 my $new_text = $self->parse_block($block, @indices);
224 if (!defined($new_text)) {
225 $main::lxdebug->leave_sub();
228 $$new_contents .= $new_text;
231 $main::lxdebug->leave_sub();