X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FTemplate.pm;h=b20a7b1a3b5a25c55713b0daa10a53f972162e11;hb=30b4a78c4100ebdcd6e6917fbcbf1d12f4f7b4d6;hp=fe4b24893aa2ef84e505da043444add2657d4418;hpb=660206845e6f0d045b65b649e4b5750a968443e6;p=kivitendo-erp.git diff --git a/SL/Template.pm b/SL/Template.pm index fe4b24893..b20a7b1a3 100644 --- a/SL/Template.pm +++ b/SL/Template.pm @@ -6,1448 +6,57 @@ # #==================================================================== -package SimpleTemplate; +package SL::Template; -# 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; -} +use strict; -sub _init { - my $self = shift; +use IO::Dir; - $self->{source} = shift; - $self->{form} = shift; - $self->{myconfig} = shift; - $self->{userspath} = shift; +use SL::Template::Simple; +use SL::Template::Excel; +use SL::Template::HTML; +use SL::Template::LaTeX; +use SL::Template::OpenDocument; +use SL::Template::PlainText; +use SL::Template::ShellCommand; - $self->{error} = undef; - $self->{quot_re} = '"'; +sub create { + my %params = @_; + my $package = "SL::Template::" . $params{type}; - $self->set_tag_style('<%', '%>'); + $package->new( + %params, + source => $params{file_name}, + form => $params{form}, + myconfig => $params{myconfig} || \%::myconfig, + userspath => $params{userspath} || $::lx_office_conf{paths}->{userspath}, + ); } -sub set_tag_style { - my $self = shift; - my $tag_start = shift; - my $tag_end = shift; +sub available_templates { + my ($class) = @_; - $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}"; -} - -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 { - my $self = shift; - my $var = shift; - my $get_array = shift; - my @indices = @_; - - my $form = $self->{form}; - my $value; - - if (($get_array || @indices) && (ref $form->{TEMPLATE_ARRAYS} eq 'HASH') && (ref $form->{TEMPLATE_ARRAYS}->{$var} eq 'ARRAY')) { - $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]]; + # is there a templates basedir + if (!-d $::lx_office_conf{paths}->{templates}) { + $::form->error(sprintf($::locale->text("The directory %s does not exist."), $::lx_office_conf{paths}->{templates})); } - 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]); - my ($var, @options) = split(/\s+/, $1); - - my $value = $self->_get_loop_variable($var, 0, @indices); - $value = $self->format_string($value) unless (grep(/^NOESCAPE$/, @options)); - - 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} - (.*?)(?{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; - 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; - ($block, $$contents) = $self->find_end($$contents, 0, $var, $not); - 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); - 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; - -#### -#### LaTeXTemplate -#### - -package LaTeXTemplate; - -use vars qw(@ISA); - -@ISA = qw(SimpleTemplate); - -sub new { - my $type = shift; - - my $self = $type->SUPER::new(@_); - - return $self; -} - -sub format_string { - my ($self, $variable) = @_; - my $form = $self->{"form"}; - - $variable = $main::locale->quote_special_chars('Template/LaTeX', $variable); - - # Allow some HTML markup to be converted into the output format's - # corresponding markup code, e.g. bold or italic. - my %markup_replace = ('b' => 'textbf', - 'i' => 'textit', - 'u' => 'underline'); - - foreach my $key (keys(%markup_replace)) { - my $new = $markup_replace{$key}; - $variable =~ s/\$\<\$${key}\$\>\$(.*?)\$<\$\/${key}\$>\$/\\${new}\{$1\}/gi; - } - - $variable =~ s/[\x00-\x1f]//g; - - return $variable; -} - -sub parse_foreach { - my ($self, $var, $text, $start_tag, $end_tag, @indices) = @_; - - my ($form, $new_contents) = ($self->{"form"}, ""); - - my $ary = $self->_get_loop_variable($var, 1, @indices); - - my $sum = 0; - my $current_page = 1; - my ($current_line, $corrent_row) = (0, 1); - my $description_array = $self->_get_loop_variable("description", 1); - my $longdescription_array = $self->_get_loop_variable("longdescription", 1); - my $linetotal_array = $self->_get_loop_variable("linetotal", 1); - - $form->{TEMPLATE_ARRAYS}->{cumulatelinetotal} = []; - - for (my $i = 0; $i < scalar(@{$ary}); $i++) { - $form->{"__first__"} = $i == 1; - $form->{"__last__"} = ($i + 1) == scalar(@{$ary}); - $form->{"__odd__"} = (($i + 1) % 2) == 1; - $form->{"__counter__"} = $i + 1; - - if (scalar @{$description_array} == scalar @{$ary} && $self->{"chars_per_line"} != 0) { - my $lines = int(length($description_array->[$i]) / $self->{"chars_per_line"}); - my $lpp; - - $description_array->[$i] =~ s/(\\newline\s?)*$//; - my $_description = $description_array->[$i]; - while ($_description =~ /\\newline/) { - $lines++; - $_description =~ s/\\newline//; - } - $lines++; - - if ($current_page == 1) { - $lpp = $self->{"lines_on_first_page"}; - } else { - $lpp = $self->{"lines_on_second_page"}; - } - - # Yes we need a manual page break -- or the user has forced one - if ((($current_line + $lines) > $lpp) || ($description_array->[$i] =~ //) || ($longdescription_array->[$i] =~ //)) { - my $pb = $self->{"pagebreak_block"}; - - # replace the special variables <%sumcarriedforward%> - # and <%lastpage%> - - my $psum = $form->format_amount($self->{"myconfig"}, $sum, 2); - $pb =~ s/$self->{tag_start_qm}sumcarriedforward$self->{tag_end_qm}/$psum/g; - $pb =~ s/$self->{tag_start_qm}lastpage$self->{tag_end_qm}/$current_page/g; - - my $new_text = $self->parse_block($pb, (@indices, $i)); - return undef unless (defined($new_text)); - $new_contents .= $new_text; - - $current_page++; - $current_line = 0; - } - $current_line += $lines; - } - - if ($i < scalar(@{$linetotal_array})) { - $sum += $form->parse_amount($self->{"myconfig"}, $linetotal_array->[$i]); - } - - $form->{TEMPLATE_ARRAYS}->{cumulatelinetotal}->[$i] = $form->format_amount($self->{"myconfig"}, $sum, 2); - - my $new_text = $self->parse_block($text, (@indices, $i)); - return undef unless (defined($new_text)); - $new_contents .= $start_tag . $new_text . $end_tag; - } - map({ delete($form->{"__${_}__"}); } qw(first last odd counter)); - - return $new_contents; -} - -sub find_end { - my ($self, $text, $pos, $var, $not) = @_; - - my $tag_start_len = length $self->{tag_start}; - - my $depth = 1; - $pos = 0 unless ($pos); - - while ($pos < length($text)) { - $pos++; - - next if (substr($text, $pos - 1, length($self->{tag_start})) ne $self->{tag_start}); - - my $keyword_pos = $pos - 1 + $tag_start_len; - - if ((substr($text, $keyword_pos, 2) eq 'if') || (substr($text, $keyword_pos, 3) eq 'for')) { - $depth++; - - } elsif ((substr($text, $keyword_pos, 4) eq 'else') && (1 == $depth)) { - if (!$var) { - $self->{"error"} = - "$self->{tag_start}else$self->{tag_end} outside of " - . "$self->{tag_start}if$self->{tag_end} / " - . "$self->{tag_start}ifnot$self->{tag_end}."; - return undef; - } - - my $block = substr($text, 0, $pos - 1); - substr($text, 0, $pos - 1) = ""; - $text =~ s!^$self->{tag_start_qm}.+?$self->{tag_end_qm}!!; - $text = $self->{tag_start} . 'if' . ($not ? " " : "not ") . $var . $self->{tag_end} . $text; - - return ($block, $text); - - } elsif (substr($text, $keyword_pos, 3) eq 'end') { - $depth--; - if ($depth == 0) { - my $block = substr($text, 0, $pos - 1); - substr($text, 0, $pos - 1) = ""; - $text =~ s!^$self->{tag_start_qm}.+?$self->{tag_end_qm}!!; - - return ($block, $text); - } - } - } - - return undef; -} - -sub parse_block { - $main::lxdebug->enter_sub(); - - my ($self, $contents, @indices) = @_; - - my $new_contents = ""; - - while ($contents ne "") { - my $pos_if = index($contents, $self->{tag_start} . 'if'); - my $pos_foreach = index($contents, $self->{tag_start} . 'foreach'); - - if ((-1 == $pos_if) && (-1 == $pos_foreach)) { - $new_contents .= $self->substitute_vars($contents, @indices); - last; - } - - if ((-1 == $pos_if) || ((-1 != $pos_foreach) && ($pos_if > $pos_foreach))) { - $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}|) { - $self->{"error"} = "Malformed $self->{tag_start}foreach$self->{tag_end}."; - $main::lxdebug->leave_sub(); - return undef; - } - - my $var = $1; - - substr($contents, 0, length($&)) = ""; - - my $block; - ($block, $contents) = $self->find_end($contents); - if (!$block) { - $self->{"error"} = "Unclosed $self->{tag_start}foreach$self->{tag_end}." unless ($self->{"error"}); - $main::lxdebug->leave_sub(); - return undef; - } + tie my %dir_h, 'IO::Dir', $::lx_office_conf{paths}->{templates}; - my $new_text = $self->parse_foreach($var, $block, "", "", @indices); - if (!defined($new_text)) { - $main::lxdebug->leave_sub(); - return undef; - } - $new_contents .= $new_text; - - } else { - if (!$self->_parse_block_if(\$contents, \$new_contents, $pos_if, @indices)) { - $main::lxdebug->leave_sub(); - return undef; - } - } - } - - $main::lxdebug->leave_sub(); - - return $new_contents; -} - -sub parse_first_line { - my $self = shift; - my $line = shift || ""; - - if ($line =~ m/([^\s]+)set-tag-style([^\s]+)/) { - if ($1 eq $2) { - $self->{error} = "The tag start and end markers must not be equal."; - return 0; - } - - $self->set_tag_style($1, $2); - } - - return 1; -} - -sub _parse_config_option { - my $self = shift; - my $line = shift; - - $line =~ s/^\s*//; - $line =~ s/\s*$//; - - my ($key, $value) = split m/\s*=\s*/, $line, 2; - - if ($key eq 'tag-style') { - $self->set_tag_style(split(m/\s+/, $value, 2)); - } -} - -sub _parse_config_lines { - my $self = shift; - my $lines = shift; - - my ($comment_start, $comment_end) = ("", ""); - - if (ref $self eq 'LaTeXTemplate') { - $comment_start = '\s*%'; - } elsif (ref $self eq 'HTMLTemplate') { - $comment_start = '\s*