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}";
64 # 1. A typeglob for the file handle. The output will be written
65 # to this file handle.
68 # 1 on success and undef or 0 if there was an error. In the latter case
69 # the calling function can retrieve the error message via $obj->get_error()
74 print(OUT "Hallo!\n");
80 return $self->{"error"};
87 sub _get_loop_variable {
90 my $get_array = shift;
93 my $form = $self->{form};
98 for my $part (split(m/\./, $var)) {
99 if (ref($value) =~ m/^(?:Form|HASH)$/) {
100 $value = $value->{$part};
101 } elsif (blessed($value) && $value->can($part)) {
102 $value = $value->$part;
108 } elsif (($get_array || @indices) && (ref $form->{TEMPLATE_ARRAYS} eq 'HASH') && (ref $form->{TEMPLATE_ARRAYS}->{$var} eq 'ARRAY')) {
109 $value = $form->{TEMPLATE_ARRAYS}->{$var};
111 $value = $form->{$var};
114 for (my $i = 0; $i < scalar(@indices); $i++) {
115 last unless (ref($value) eq "ARRAY");
116 $value = $value->[$indices[$i]];
122 sub substitute_vars {
123 my ($self, $text, @indices) = @_;
125 my $form = $self->{"form"};
127 while ($text =~ /$self->{substitute_vars_re}/) {
128 my ($tag_pos, $tag_len) = ($-[0], $+[0] - $-[0]);
129 my ($var, @options) = split(/\s+/, $1);
131 my $value = $self->_get_loop_variable($var, 0, @indices);
132 $value = $self->format_string($value) unless (grep(/^NOESCAPE$/, @options));
134 substr($text, $tag_pos, $tag_len, $value);
140 sub _parse_block_if {
141 $main::lxdebug->enter_sub();
144 my $contents = shift;
145 my $new_contents = shift;
149 $$new_contents .= $self->substitute_vars(substr($$contents, 0, $pos_if), @indices);
150 substr($$contents, 0, $pos_if) = "";
152 if ($$contents !~ m/^$self->{tag_start_qm}if
154 (not\b|\!)? # $1 -- Eventuelle Negierung
156 (\b.+?\b) # $2 -- Name der zu überprüfenden Variablen
157 ( # $3 -- Beginn des optionalen Vergleiches
159 ([!=]) # $4 -- Negierung des Vergleiches speichern
160 ([=~]) # $5 -- Art des Vergleiches speichern
162 ( # $6 -- Gequoteter String oder Bareword
164 (.*?)(?<!\\) # $7 -- Gequoteter String -- direkter Vergleich mit eq bzw. ne oder Patternmatching; Escapete Anführungs als Teil des Strings belassen
167 (\b.+?\b) # $8 -- Bareword -- als Index für $form benutzen
173 $self->{"error"} = "Malformed $self->{tag_start}if$self->{tag_end}.";
174 $main::lxdebug->leave_sub();
180 my $comparison = $3; # Optionaler Match um $4..$8
181 my $operator_neg = $4; # '=' oder '!' oder undef, wenn kein Vergleich erkannt
182 my $operator_type = $5; # '=' oder '~' für Stringvergleich oder Regex
183 my $quoted_word = $7; # nur gültig, wenn quoted string angegeben (siehe unten); dann "value" aus <%if var == "value" %>
184 my $bareword = $8; # undef, falls quoted string angegeben wurde; andernfalls "othervar" aus <%if var == othervar %>
186 $not = !$not if ($operator_neg && $operator_neg eq '!');
188 substr($$contents, 0, length($&)) = "";
191 ($block, $$contents) = $self->find_end($$contents, 0, "$var $comparison", $not);
193 $self->{"error"} = "Unclosed $self->{tag_start}if$self->{tag_end}." unless ($self->{"error"});
194 $main::lxdebug->leave_sub();
198 my $value = $self->_get_loop_variable($var, 0, @indices);
201 if ($operator_type) {
202 my $compare_to = $bareword ? $self->_get_loop_variable($bareword, 0, @indices) : $quoted_word;
203 if ($operator_type eq '=') {
204 $hit = ($not && !($value eq $compare_to)) || (!$not && ($value eq $compare_to));
206 $hit = ($not && !($value =~ m/$compare_to/i)) || (!$not && ($value =~ m/$compare_to/i));
210 $hit = ($not && ! $value) || (!$not && $value);
214 my $new_text = $self->parse_block($block, @indices);
215 if (!defined($new_text)) {
216 $main::lxdebug->leave_sub();
219 $$new_contents .= $new_text;
222 $main::lxdebug->leave_sub();