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
33 my ($self, %params) = @_;
35 $self->{$_} = $params{$_} for keys %params;
37 $self->{error} = undef;
38 $self->{quot_re} = '"';
40 $self->set_tag_style('<%', '%>');
45 my $tag_start = shift;
48 $self->{custom_tag_style} = 1;
49 $self->{tag_start} = $tag_start;
50 $self->{tag_end} = $tag_end;
51 $self->{tag_start_qm} = quotemeta $tag_start;
52 $self->{tag_end_qm} = quotemeta $tag_end;
54 $self->{substitute_vars_re} = "$self->{tag_start_qm}(.+?)$self->{tag_end_qm}";
57 sub set_use_template_toolkit {
61 $self->{use_template_toolkit} = $value;
69 # 1. A typeglob for the file handle. The output will be written
70 # to this file handle.
73 # 1 on success and undef or 0 if there was an error. In the latter case
74 # the calling function can retrieve the error message via $obj->get_error()
79 print(OUT "Hallo!\n");
85 return $self->{"error"};
92 sub _get_loop_variable {
93 my ($self, $var, $get_array, @indices) = @_;
94 my $form = $self->{form};
95 my ($value, @methods);
98 ($var, @methods) = split m/\./, $var;
101 if (($get_array || @indices) && (ref $form->{TEMPLATE_ARRAYS} eq 'HASH') && (ref $form->{TEMPLATE_ARRAYS}->{$var} eq 'ARRAY')) {
102 $value = $form->{TEMPLATE_ARRAYS}->{$var};
104 $value = $form->{$var};
107 for (my $i = 0; $i < scalar(@indices); $i++) {
108 last unless (ref($value) eq "ARRAY");
109 $value = $value->[$indices[$i]];
112 for my $part (@methods) {
113 if (ref($value) =~ m/^(?:Form|HASH)$/) {
114 $value = $value->{$part};
115 } elsif (blessed($value) && $value->can($part)) {
116 $value = $value->$part;
126 sub substitute_vars {
127 my ($self, $text, @indices) = @_;
129 my $form = $self->{"form"};
131 while ($text =~ /$self->{substitute_vars_re}/) {
132 my ($tag_pos, $tag_len) = ($-[0], $+[0] - $-[0]);
133 my ($var, @option_list) = split(/\s+/, $1);
134 my %options = map { ($_ => 1) } @option_list;
136 my $value = $self->_get_loop_variable($var, 0, @indices);
137 $value = $form->parse_amount({ numberformat => $::myconfig{output_numberformat} || $::myconfig{numberformat} }, $value) if $options{NOFORMAT};
138 $value = $self->format_string($value) unless $options{NOESCAPE};
140 substr($text, $tag_pos, $tag_len, $value);
146 sub _parse_block_if {
147 $main::lxdebug->enter_sub();
150 my $contents = shift;
151 my $new_contents = shift;
155 $$new_contents .= $self->substitute_vars(substr($$contents, 0, $pos_if), @indices);
156 substr($$contents, 0, $pos_if) = "";
158 if ($$contents !~ m/^$self->{tag_start_qm}if
160 (not\b|\!)? # $1 -- Eventuelle Negierung
162 (\b.+?\b) # $2 -- Name der zu überprüfenden Variablen
163 ( # $3 -- Beginn des optionalen Vergleiches
165 ([!=]) # $4 -- Negierung des Vergleiches speichern
166 ([=~]) # $5 -- Art des Vergleiches speichern
168 ( # $6 -- Gequoteter String oder Bareword
170 (.*?)(?<!\\) # $7 -- Gequoteter String -- direkter Vergleich mit eq bzw. ne oder Patternmatching; Escapete Anführungs als Teil des Strings belassen
173 (\b.+?\b) # $8 -- Bareword -- als Index für $form benutzen
179 $self->{"error"} = "Malformed $self->{tag_start}if$self->{tag_end}.";
180 $main::lxdebug->leave_sub();
186 my $comparison = $3; # Optionaler Match um $4..$8
187 my $operator_neg = $4; # '=' oder '!' oder undef, wenn kein Vergleich erkannt
188 my $operator_type = $5; # '=' oder '~' für Stringvergleich oder Regex
189 my $quoted_word = $7; # nur gültig, wenn quoted string angegeben (siehe unten); dann "value" aus <%if var == "value" %>
190 my $bareword = $8; # undef, falls quoted string angegeben wurde; andernfalls "othervar" aus <%if var == othervar %>
192 $not = !$not if ($operator_neg && $operator_neg eq '!');
194 substr($$contents, 0, length($&)) = "";
197 ($block, $$contents) = $self->find_end($$contents, 0, "$var $comparison", $not);
199 $self->{"error"} = "Unclosed $self->{tag_start}if$self->{tag_end}." unless ($self->{"error"});
200 $main::lxdebug->leave_sub();
204 my $value = $self->_get_loop_variable($var, 0, @indices);
205 $value = scalar(@{ $value }) if (ref($value) || '') eq 'ARRAY';
208 if ($operator_type) {
209 my $compare_to = $bareword ? $self->_get_loop_variable($bareword, 0, @indices) : $quoted_word;
210 if ($operator_type eq '=') {
211 $hit = ($not && !($value eq $compare_to)) || (!$not && ($value eq $compare_to));
213 $hit = ($not && !($value =~ m/$compare_to/i)) || (!$not && ($value =~ m/$compare_to/i));
217 $hit = ($not && ! $value) || (!$not && $value);
221 my $new_text = $self->parse_block($block, @indices);
222 if (!defined($new_text)) {
223 $main::lxdebug->leave_sub();
226 $$new_contents .= $new_text;
229 $main::lxdebug->leave_sub();