my ($yy, $mm, $dd) = $self->parse_date($myconfig, $date);
- $output_format =~ /d+/;
+ $output_format =~ /(d+)/;
substr($output_format, $-[0], $+[0] - $-[0]) =
- sprintf("%0" . (length($&)) . "d", $dd);
+ sprintf("%0" . (length($1)) . "d", $dd);
- $output_format =~ /m+/;
+ $output_format =~ /(m+)/;
substr($output_format, $-[0], $+[0] - $-[0]) =
- sprintf("%0" . (length($&)) . "d", $mm);
+ sprintf("%0" . (length($1)) . "d", $mm);
$output_format =~ /y+/;
substr($output_format, $-[0], $+[0] - $-[0]) = $yy;
$yy = $yy % 100 if 2 == $yy_len;
my $format = ref $myconfig eq '' ? "$myconfig" : $myconfig->{dateformat};
- $format =~ s{ d+ }{ sprintf("%0" . (length($&)) . "d", $dd) }gex;
- $format =~ s{ m+ }{ sprintf("%0" . (length($&)) . "d", $mm) }gex;
- $format =~ s{ y+ }{ sprintf("%0${yy_len}d", $yy) }gex;
+ $format =~ s{ (d+) }{ sprintf("%0" . (length($1)) . "d", $dd) }gex;
+ $format =~ s{ (m+) }{ sprintf("%0" . (length($1)) . "d", $mm) }gex;
+ $format =~ s{ (y+) }{ sprintf("%0${yy_len}d", $yy) }gex;
$main::lxdebug->leave_sub();
my $contents = join("", @lines);
my @indices;
$contents =~ s%
- $self->{tag_start} [<]* (\s?) [<>\s]* ([\w\s]+) [<>\s]* $self->{tag_end}
+ ( $self->{tag_start} [<]* (\s?) [<>\s]* ([\w\s]+) [<>\s]* $self->{tag_end} )
%
- $self->format_vars(align_right => $1 ne '', varstring => $2, length => length($&), indices => \@indices)
+ $self->format_vars(align_right => $2 ne '', varstring => $3, length => length($1), indices => \@indices)
%egx;
if (!defined($contents)) {
$new_contents .= $self->substitute_vars(substr($contents, 0, $pos_foreach), @indices);
substr($contents, 0, $pos_foreach) = "";
- if ($contents !~ m|^$self->{tag_start_qm}foreach (.+?)$self->{tag_end_qm}|) {
+ if ($contents !~ m|^($self->{tag_start_qm}foreach (.+?)$self->{tag_end_qm})|) {
$self->{"error"} = "Malformed $self->{tag_start}foreach$self->{tag_end}.";
$main::lxdebug->leave_sub();
return undef;
}
- my $var = $1;
+ my $var = $2;
- substr($contents, 0, length($&)) = "";
+ substr($contents, 0, length($1)) = "";
my $block;
($block, $contents) = $self->find_end($contents);
my $contents = join("", @lines);
# detect pagebreak block and its parameters
- if ($contents =~ /$self->{tag_start_qm}pagebreak\s+(\d+)\s+(\d+)\s+(\d+)\s*$self->{tag_end_qm}(.*?)$self->{tag_start_qm}end(\s*pagebreak)?$self->{tag_end_qm}/s) {
- $self->{"chars_per_line"} = $1;
- $self->{"lines_on_first_page"} = $2;
- $self->{"lines_on_second_page"} = $3;
- $self->{"pagebreak_block"} = $4;
+ if ($contents =~ /^(.*)($self->{tag_start_qm}pagebreak\s+(\d+)\s+(\d+)\s+(\d+)\s*$self->{tag_end_qm}(.*?)$self->{tag_start_qm}end(\s*pagebreak)?$self->{tag_end_qm})/s) {
+ $self->{"chars_per_line"} = $3;
+ $self->{"lines_on_first_page"} = $4;
+ $self->{"lines_on_second_page"} = $5;
+ $self->{"pagebreak_block"} = $6;
- substr($contents, length($`), length($&)) = "";
+ substr($contents, length($1), length($2)) = "";
}
$self->{"forced_pagebreaks"} = [];
while ($contents ne "") {
if (substr($contents, 0, 1) eq "<") {
- $contents =~ m|^<[^>]+>|;
- my $tag = $&;
- substr($contents, 0, length($&)) = "";
+ $contents =~ m|^(<[^>]+>)|;
+ my $tag = $1;
+ substr($contents, 0, length($1)) = "";
$self->{current_text_style} = $1 if $tag =~ m|text:style-name\s*=\s*"([^"]+)"|;
if ($table_row =~ m|\<\%foreachrow\s+(.*?)\%\>|) {
my $var = $1;
- $contents =~ m|\<\%foreachrow\s+.*?\%\>|;
- substr($contents, length($`), length($&)) = "";
+ $contents =~ m|^(.*?)(\<\%foreachrow\s+.*?\%\>)|;
+ substr($contents, length($1), length($2)) = "";
- ($table_row, $contents) = $self->find_end($contents, length($`));
+ ($table_row, $contents) = $self->find_end($contents, length($1));
if (!$table_row) {
$self->{"error"} = "Unclosed <\%foreachrow\%>." unless ($self->{"error"});
$main::lxdebug->leave_sub();
$table_row .= $1;
$end_tag = $2;
- substr $contents, 0, length($&), '';
+ substr $contents, 0, length($2), '';
my $new_text = $self->parse_foreach($var, $table_row, $tag, $end_tag, @indices);
if (!defined($new_text)) {
}
} else {
- $contents =~ /^[^<]+/;
- my $text = $&;
+ $contents =~ /^([^<]+)/;
+ my $text = $1;
my $pos_if = index($text, '<%if');
my $pos_foreach = index($text, '<%foreach');
$new_contents .= $self->substitute_vars(substr($contents, 0, $pos_foreach), @indices);
substr($contents, 0, $pos_foreach) = "";
- if ($contents !~ m|^\<\%foreach (.*?)\%\>|) {
+ if ($contents !~ m|^(\<\%foreach (.*?)\%\>)|) {
$self->{"error"} = "Malformed <\%foreach\%>.";
$main::lxdebug->leave_sub();
return undef;
}
- my $var = $1;
+ my $var = $2;
- substr($contents, 0, length($&)) = "";
+ substr($contents, 0, length($1)) = "";
my $block;
($block, $contents) = $self->find_end($contents);
$$new_contents .= $self->substitute_vars(substr($$contents, 0, $pos_if), @indices);
substr($$contents, 0, $pos_if) = "";
- if ($$contents !~ m/^$self->{tag_start_qm}if
+ if ($$contents !~ m/^( $self->{tag_start_qm}if
\s*
- (not\b|\!)? # $1 -- Eventuelle Negierung
+ (not\b|\!)? # $2 -- Eventuelle Negierung
\s+
- (\b.+?\b) # $2 -- Name der zu überprüfenden Variablen
- ( # $3 -- Beginn des optionalen Vergleiches
+ (\b.+?\b) # $3 -- Name der zu überprüfenden Variablen
+ ( # $4 -- Beginn des optionalen Vergleiches
\s*
- ([!=]) # $4 -- Negierung des Vergleiches speichern
- ([=~]) # $5 -- Art des Vergleiches speichern
+ ([!=]) # $5 -- Negierung des Vergleiches speichern
+ ([=~]) # $6 -- Art des Vergleiches speichern
\s*
- ( # $6 -- Gequoteter String oder Bareword
+ ( # $7 -- 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
+ (.*?)(?<!\\) # $8 -- 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
+ (\b.+?\b) # $9 -- Bareword -- als Index für $form benutzen
)
)?
\s*
- $self->{tag_end_qm}
+ $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 %>
+ my $not = $2;
+ my $var = $3;
+ my $comparison = $4; # Optionaler Match um $4..$8
+ my $operator_neg = $5; # '=' oder '!' oder undef, wenn kein Vergleich erkannt
+ my $operator_type = $6; # '=' oder '~' für Stringvergleich oder Regex
+ my $quoted_word = $8; # nur gültig, wenn quoted string angegeben (siehe unten); dann "value" aus <%if var == "value" %>
+ my $bareword = $9; # undef, falls quoted string angegeben wurde; andernfalls "othervar" aus <%if var == othervar %>
$not = !$not if ($operator_neg && $operator_neg eq '!');
- substr($$contents, 0, length($&)) = "";
+ substr($$contents, 0, length($1)) = "";
my $block;
($block, $$contents) = $self->find_end($$contents, 0, "$var $comparison", $not);