1 #====================================================================
 
   4 # Based on SQL-Ledger Version 2.1.9
 
   5 # Web http://www.lx-office.org
 
   7 #====================================================================
 
  10 #    NOTE: strict checks are package global. don't check this file
 
  11 #            with perl -sc, it will only capture SimpleTemplate
 
  15 package SimpleTemplate;
 
  20 #   1. The template's file name
 
  21 #   2. A reference to the Form object
 
  22 #   3. A reference to the myconfig hash
 
  25 #   A new template object
 
  39   $self->{source}    = shift;
 
  40   $self->{form}      = shift;
 
  41   $self->{myconfig}  = shift;
 
  42   $self->{userspath} = shift;
 
  44   $self->{error}     = undef;
 
  45   $self->{quot_re}   = '"';
 
  47   $self->set_tag_style('<%', '%>');
 
  52   my $tag_start               = shift;
 
  55   $self->{tag_start}          = $tag_start;
 
  56   $self->{tag_end}            = $tag_end;
 
  57   $self->{tag_start_qm}       = quotemeta $tag_start;
 
  58   $self->{tag_end_qm}         = quotemeta $tag_end;
 
  60   $self->{substitute_vars_re} = "$self->{tag_start_qm}(.+?)$self->{tag_end_qm}";
 
  68 #   1. A typeglob for the file handle. The output will be written
 
  69 #      to this file handle.
 
  72 #   1 on success and undef or 0 if there was an error. In the latter case
 
  73 #   the calling function can retrieve the error message via $obj->get_error()
 
  78   print(OUT "Hallo!\n");
 
  84   return $self->{"error"};
 
  91 sub _get_loop_variable {
 
  94   my $get_array = shift;
 
  97   my $form      = $self->{form};
 
 100   if (($get_array || @indices) && (ref $form->{TEMPLATE_ARRAYS} eq 'HASH') && (ref $form->{TEMPLATE_ARRAYS}->{$var} eq 'ARRAY')) {
 
 101     $value = $form->{TEMPLATE_ARRAYS}->{$var};
 
 103     $value = $form->{$var};
 
 106   for (my $i = 0; $i < scalar(@indices); $i++) {
 
 107     last unless (ref($value) eq "ARRAY");
 
 108     $value = $value->[$indices[$i]];
 
 114 sub substitute_vars {
 
 115   my ($self, $text, @indices) = @_;
 
 117   my $form = $self->{"form"};
 
 119   while ($text =~ /$self->{substitute_vars_re}/) {
 
 120     my ($tag_pos, $tag_len) = ($-[0], $+[0] - $-[0]);
 
 121     my ($var, @options)     = split(/\s+/, $1);
 
 123     my $value               = $self->_get_loop_variable($var, 0, @indices);
 
 124     $value                  = $self->format_string($value) unless (grep(/^NOESCAPE$/, @options));
 
 126     substr($text, $tag_pos, $tag_len, $value);
 
 132 sub _parse_block_if {
 
 133   $main::lxdebug->enter_sub();
 
 136   my $contents     = shift;
 
 137   my $new_contents = shift;
 
 141   $$new_contents .= $self->substitute_vars(substr($$contents, 0, $pos_if), @indices);
 
 142   substr($$contents, 0, $pos_if) = "";
 
 144   if ($$contents !~ m/^$self->{tag_start_qm}if
 
 146                      (not\b|\!)?           # $1 -- Eventuelle Negierung
 
 148                      (\b.+?\b)             # $2 -- Name der zu überprüfenden Variablen
 
 149                      (                     # $3 -- Beginn des optionalen Vergleiches
 
 151                        ([!=])              # $4 -- Negierung des Vergleiches speichern
 
 152                        ([=~])              # $5 -- Art des Vergleiches speichern
 
 154                        (                   # $6 -- Gequoteter String oder Bareword
 
 156                          (.*?)(?<!\\)      # $7 -- Gequoteter String -- direkter Vergleich mit eq bzw. ne oder Patternmatching; Escapete Anführungs als Teil des Strings belassen
 
 159                          (\b.+?\b)         # $8 -- Bareword -- als Index für $form benutzen
 
 165     $self->{"error"} = "Malformed $self->{tag_start}if$self->{tag_end}.";
 
 166     $main::lxdebug->leave_sub();
 
 172   my $operator_neg  = $4; # '=' oder '!' oder undef, wenn kein Vergleich erkannt
 
 173   my $operator_type = $5; # '=' oder '~' für Stringvergleich oder Regex
 
 174   my $quoted_word   = $7; # nur gültig, wenn quoted string angegeben (siehe unten); dann "value" aus <%if var == "value" %>
 
 175   my $bareword      = $8; # undef, falls quoted string angegeben wurde; andernfalls "othervar" aus <%if var == othervar %>
 
 177   $not = !$not if ($operator_neg && $operator_neg eq '!');
 
 179   substr($$contents, 0, length($&)) = "";
 
 182   ($block, $$contents) = $self->find_end($$contents, 0, $var, $not);
 
 184     $self->{"error"} = "Unclosed $self->{tag_start}if$self->{tag_end}." unless ($self->{"error"});
 
 185     $main::lxdebug->leave_sub();
 
 189   my $value = $self->_get_loop_variable($var, 0, @indices);
 
 192   if ($operator_type) {
 
 193     my $compare_to = $bareword ? $self->_get_loop_variable($bareword, 0, @indices) : $quoted_word;
 
 194     if ($operator_type eq '=') {
 
 195       $hit         = ($not && !($value eq $compare_to))     || (!$not && ($value eq $compare_to));
 
 197       $hit         = ($not && !($value =~ m/$compare_to/i)) || (!$not && ($value =~ m/$compare_to/i));
 
 201     $hit           = ($not && ! $value)                     || (!$not &&  $value);
 
 205     my $new_text = $self->parse_block($block, @indices);
 
 206     if (!defined($new_text)) {
 
 207       $main::lxdebug->leave_sub();
 
 210     $$new_contents .= $new_text;
 
 213   $main::lxdebug->leave_sub();
 
 224 package LaTeXTemplate;
 
 228 @ISA = qw(SimpleTemplate);
 
 235   my $self = $type->SUPER::new(@_);
 
 241   my ($self, $variable) = @_;
 
 242   my $form = $self->{"form"};
 
 244   $variable = $main::locale->quote_special_chars('Template/LaTeX', $variable);
 
 246   # Allow some HTML markup to be converted into the output format's
 
 247   # corresponding markup code, e.g. bold or italic.
 
 248   my %markup_replace = ('b' => 'textbf',
 
 252   foreach my $key (keys(%markup_replace)) {
 
 253     my $new = $markup_replace{$key};
 
 254     $variable =~ s/\$\<\$${key}\$\>\$(.*?)\$<\$\/${key}\$>\$/\\${new}\{$1\}/gi;
 
 257   $variable =~ s/[\x00-\x1f]//g;
 
 263   my ($self, $var, $text, $start_tag, $end_tag, @indices) = @_;
 
 265   my ($form, $new_contents) = ($self->{"form"}, "");
 
 267   my $ary = $self->_get_loop_variable($var, 1, @indices);
 
 270   my $current_page                 = 1;
 
 271   my ($current_line, $corrent_row) = (0, 1);
 
 272   my $description_array            = $self->_get_loop_variable("description",     1);
 
 273   my $longdescription_array        = $self->_get_loop_variable("longdescription", 1);
 
 274   my $linetotal_array              = $self->_get_loop_variable("linetotal",       1);
 
 276   $form->{TEMPLATE_ARRAYS}->{cumulatelinetotal} = [];
 
 278   # forech block hasn't given us an array. ignore
 
 279   return $new_contents unless ref $ary eq 'ARRAY';
 
 281   for (my $i = 0; $i < scalar(@{$ary}); $i++) {
 
 283     $form->{"__first__"}   = $i == 1;
 
 284     $form->{"__last__"}    = ($i + 1) == scalar(@{$ary});
 
 285     $form->{"__odd__"}     = (($i + 1) % 2) == 1;
 
 286     $form->{"__counter__"} = $i + 1;
 
 288     if (   ref $description_array       eq 'ARRAY'
 
 289         && scalar @{$description_array} == scalar @{$ary}
 
 290         && $self->{"chars_per_line"}    != 0)
 
 292       my $lines = int(length($description_array->[$i]) / $self->{"chars_per_line"});
 
 295       $description_array->[$i] =~ s/(\\newline\s?)*$//;
 
 296       $lines++ while ($description_array->[$i] =~ m/\\newline/g);
 
 299       if ($current_page == 1) {
 
 300         $lpp = $self->{"lines_on_first_page"};
 
 302         $lpp = $self->{"lines_on_second_page"};
 
 305       # Yes we need a manual page break -- or the user has forced one
 
 306       if (   (($current_line + $lines) > $lpp)
 
 307           || ($description_array->[$i]     =~ /<pagebreak>/)
 
 308           || (   ref $longdescription_array eq 'ARRAY'
 
 309               && $longdescription_array->[$i] =~ /<pagebreak>/)) {
 
 310         my $pb = $self->{"pagebreak_block"};
 
 312         # replace the special variables <%sumcarriedforward%>
 
 315         my $psum = $form->format_amount($self->{"myconfig"}, $sum, 2);
 
 316         $pb =~ s/$self->{tag_start_qm}sumcarriedforward$self->{tag_end_qm}/$psum/g;
 
 317         $pb =~ s/$self->{tag_start_qm}lastpage$self->{tag_end_qm}/$current_page/g;
 
 319         my $new_text = $self->parse_block($pb, (@indices, $i));
 
 320         return undef unless (defined($new_text));
 
 321         $new_contents .= $new_text;
 
 326       $current_line += $lines;
 
 329     if (   ref $linetotal_array eq 'ARRAY'
 
 330         && $i < scalar(@{$linetotal_array})) {
 
 331       $sum += $form->parse_amount($self->{"myconfig"}, $linetotal_array->[$i]);
 
 334     $form->{TEMPLATE_ARRAYS}->{cumulatelinetotal}->[$i] = $form->format_amount($self->{"myconfig"}, $sum, 2);
 
 336     my $new_text = $self->parse_block($text, (@indices, $i));
 
 337     return undef unless (defined($new_text));
 
 338     $new_contents .= $start_tag . $new_text . $end_tag;
 
 340   map({ delete($form->{"__${_}__"}); } qw(first last odd counter));
 
 342   return $new_contents;
 
 346   my ($self, $text, $pos, $var, $not) = @_;
 
 348   my $tag_start_len = length $self->{tag_start};
 
 351   $pos = 0 unless ($pos);
 
 353   while ($pos < length($text)) {
 
 356     next if (substr($text, $pos - 1, length($self->{tag_start})) ne $self->{tag_start});
 
 358     my $keyword_pos = $pos - 1 + $tag_start_len;
 
 360     if ((substr($text, $keyword_pos, 2) eq 'if') || (substr($text, $keyword_pos, 3) eq 'for')) {
 
 363     } elsif ((substr($text, $keyword_pos, 4) eq 'else') && (1 == $depth)) {
 
 366             "$self->{tag_start}else$self->{tag_end} outside of "
 
 367           . "$self->{tag_start}if$self->{tag_end} / "
 
 368           . "$self->{tag_start}ifnot$self->{tag_end}.";
 
 372       my $block = substr($text, 0, $pos - 1);
 
 373       substr($text, 0, $pos - 1) = "";
 
 374       $text =~ s!^$self->{tag_start_qm}.+?$self->{tag_end_qm}!!;
 
 375       $text =  $self->{tag_start} . 'if' . ($not ?  " " : "not ") . $var . $self->{tag_end} . $text;
 
 377       return ($block, $text);
 
 379     } elsif (substr($text, $keyword_pos, 3) eq 'end') {
 
 382         my $block = substr($text, 0, $pos - 1);
 
 383         substr($text, 0, $pos - 1) = "";
 
 384         $text =~ s!^$self->{tag_start_qm}.+?$self->{tag_end_qm}!!;
 
 386         return ($block, $text);
 
 395   $main::lxdebug->enter_sub();
 
 397   my ($self, $contents, @indices) = @_;
 
 399   my $new_contents = "";
 
 401   while ($contents ne "") {
 
 402     my $pos_if      = index($contents, $self->{tag_start} . 'if');
 
 403     my $pos_foreach = index($contents, $self->{tag_start} . 'foreach');
 
 405     if ((-1 == $pos_if) && (-1 == $pos_foreach)) {
 
 406       $new_contents .= $self->substitute_vars($contents, @indices);
 
 410     if ((-1 == $pos_if) || ((-1 != $pos_foreach) && ($pos_if > $pos_foreach))) {
 
 411       $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_foreach), @indices);
 
 412       substr($contents, 0, $pos_foreach) = "";
 
 414       if ($contents !~ m|^$self->{tag_start_qm}foreach (.+?)$self->{tag_end_qm}|) {
 
 415         $self->{"error"} = "Malformed $self->{tag_start}foreach$self->{tag_end}.";
 
 416         $main::lxdebug->leave_sub();
 
 422       substr($contents, 0, length($&)) = "";
 
 425       ($block, $contents) = $self->find_end($contents);
 
 427         $self->{"error"} = "Unclosed $self->{tag_start}foreach$self->{tag_end}." unless ($self->{"error"});
 
 428         $main::lxdebug->leave_sub();
 
 432       my $new_text = $self->parse_foreach($var, $block, "", "", @indices);
 
 433       if (!defined($new_text)) {
 
 434         $main::lxdebug->leave_sub();
 
 437       $new_contents .= $new_text;
 
 440       if (!$self->_parse_block_if(\$contents, \$new_contents, $pos_if, @indices)) {
 
 441         $main::lxdebug->leave_sub();
 
 447   $main::lxdebug->leave_sub();
 
 449   return $new_contents;
 
 452 sub parse_first_line {
 
 454   my $line = shift || "";
 
 456   if ($line =~ m/([^\s]+)set-tag-style([^\s]+)/) {
 
 458       $self->{error} = "The tag start and end markers must not be equal.";
 
 462     $self->set_tag_style($1, $2);
 
 468 sub _parse_config_option {
 
 475   my ($key, $value) = split m/\s*=\s*/, $line, 2;
 
 477   if ($key eq 'tag-style') {
 
 478     $self->set_tag_style(split(m/\s+/, $value, 2));
 
 482 sub _parse_config_lines {
 
 486   my ($comment_start, $comment_end) = ("", "");
 
 488   if (ref $self eq 'LaTeXTemplate') {
 
 489     $comment_start = '\s*%';
 
 490   } elsif (ref $self eq 'HTMLTemplate') {
 
 491     $comment_start = '\s*<!--';
 
 492     $comment_end   = '>\s*';
 
 494     $comment_start = '\s*\#';
 
 497   my $num_lines = scalar @{ $lines };
 
 500   while ($i < $num_lines) {
 
 501     my $line = $lines->[$i];
 
 503     if ($line !~ m/^${comment_start}\s*config\s*:(.*)${comment_end}$/i) {
 
 508     $self->_parse_config_option($1);
 
 509     splice @{ $lines }, $i, 1;
 
 514 sub _force_mandatory_packages {
 
 518   my (%used_packages, $document_start_line);
 
 520   foreach my $i (0 .. scalar @{ $lines } - 1) {
 
 521     if ($lines->[$i] =~ m/\\usepackage[^\{]*{(.*?)}/) {
 
 522       $used_packages{$1} = 1;
 
 524     } elsif ($lines->[$i] =~ m/\\begin{document}/) {
 
 525       $document_start_line = $i;
 
 531   $document_start_line = scalar @{ $lines } - 1 if (!defined $document_start_line);
 
 533   if (!$used_packages{textcomp}) {
 
 534     splice @{ $lines }, $document_start_line, 0, "\\usepackage{textcomp}\n";
 
 535     $document_start_line++;
 
 542   my $form = $self->{"form"};
 
 544   if (!open(IN, "$form->{templates}/$form->{IN}")) {
 
 545     $self->{"error"} = "$!";
 
 551   $self->_parse_config_lines(\@lines);
 
 552   $self->_force_mandatory_packages(\@lines) if (ref $self eq 'LaTeXTemplate');
 
 554   my $contents = join("", @lines);
 
 556   # detect pagebreak block and its parameters
 
 557   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) {
 
 558     $self->{"chars_per_line"} = $1;
 
 559     $self->{"lines_on_first_page"} = $2;
 
 560     $self->{"lines_on_second_page"} = $3;
 
 561     $self->{"pagebreak_block"} = $4;
 
 563     substr($contents, length($`), length($&)) = "";
 
 566   $self->{"forced_pagebreaks"} = [];
 
 568   my $new_contents = $self->parse_block($contents);
 
 569   if (!defined($new_contents)) {
 
 570     $main::lxdebug->leave_sub();
 
 574   print(OUT $new_contents);
 
 576   if ($form->{"format"} =~ /postscript/i) {
 
 577     return $self->convert_to_postscript();
 
 578   } elsif ($form->{"format"} =~ /pdf/i) {
 
 579     return $self->convert_to_pdf();
 
 585 sub convert_to_postscript {
 
 587   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
 
 589   # Convert the tex file to postscript
 
 591   if (!chdir("$userspath")) {
 
 592     $self->{"error"} = "chdir : $!";
 
 597   $form->{tmpfile} =~ s/\Q$userspath\E\///g;
 
 599   my $latex = $self->_get_latex_path();
 
 601   for (my $run = 1; $run <= 2; $run++) {
 
 602     system("${latex} --interaction=nonstopmode $form->{tmpfile} " .
 
 603            "> $form->{tmpfile}.err");
 
 605       $self->{"error"} = $form->cleanup();
 
 611   $form->{tmpfile} =~ s/tex$/dvi/;
 
 613   system("dvips $form->{tmpfile} -o -q > /dev/null");
 
 615     $self->{"error"} = "dvips : $!";
 
 619   $form->{tmpfile} =~ s/dvi$/ps/;
 
 628   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
 
 630   # Convert the tex file to PDF
 
 632   if (!chdir("$userspath")) {
 
 633     $self->{"error"} = "chdir : $!";
 
 638   $form->{tmpfile} =~ s/\Q$userspath\E\///g;
 
 640   my $latex = $self->_get_latex_path();
 
 642   for (my $run = 1; $run <= 2; $run++) {
 
 643     system("${latex} --interaction=nonstopmode $form->{tmpfile} " .
 
 644            "> $form->{tmpfile}.err");
 
 646       $self->{"error"} = $form->cleanup();
 
 652   $form->{tmpfile} =~ s/tex$/pdf/;
 
 657 sub _get_latex_path {
 
 658   return $main::latex_bin || 'pdflatex';
 
 661 sub get_mime_type() {
 
 664   if ($self->{"form"}->{"format"} =~ /postscript/i) {
 
 665     return "application/postscript";
 
 667     return "application/pdf";
 
 680 package HTMLTemplate;
 
 684 @ISA = qw(LaTeXTemplate);
 
 691   return $type->SUPER::new(@_);
 
 695   my ($self, $variable) = @_;
 
 696   my $form = $self->{"form"};
 
 698   $variable = $main::locale->quote_special_chars('Template/HTML', $variable);
 
 700   # Allow some HTML markup to be converted into the output format's
 
 701   # corresponding markup code, e.g. bold or italic.
 
 702   my @markup_replace = ('b', 'i', 's', 'u', 'sub', 'sup');
 
 704   foreach my $key (@markup_replace) {
 
 705     $variable =~ s/\<(\/?)${key}\>/<$1${key}>/g;
 
 711 sub get_mime_type() {
 
 714   if ($self->{"form"}->{"format"} =~ /postscript/i) {
 
 715     return "application/postscript";
 
 716   } elsif ($self->{"form"}->{"format"} =~ /pdf/i) {
 
 717     return "application/pdf";
 
 726   if ($self->{"form"}->{"format"} =~ /postscript/i) {
 
 728   } elsif ($self->{"form"}->{"format"} =~ /pdf/i) {
 
 735 sub convert_to_postscript {
 
 737   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
 
 739   # Convert the HTML file to postscript
 
 741   if (!chdir("$userspath")) {
 
 742     $self->{"error"} = "chdir : $!";
 
 747   $form->{"tmpfile"} =~ s/\Q$userspath\E\///g;
 
 748   my $psfile = $form->{"tmpfile"};
 
 749   $psfile =~ s/.html/.ps/;
 
 750   if ($psfile eq $form->{"tmpfile"}) {
 
 754   system("html2ps -f html2ps-config < $form->{tmpfile} > $psfile");
 
 756     $self->{"error"} = $form->cleanup();
 
 761   $form->{"tmpfile"} = $psfile;
 
 770   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
 
 772   # Convert the HTML file to PDF
 
 774   if (!chdir("$userspath")) {
 
 775     $self->{"error"} = "chdir : $!";
 
 780   $form->{"tmpfile"} =~ s/\Q$userspath\E\///g;
 
 781   my $pdffile = $form->{"tmpfile"};
 
 782   $pdffile =~ s/.html/.pdf/;
 
 783   if ($pdffile eq $form->{"tmpfile"}) {
 
 787   system("html2ps -f html2ps-config < $form->{tmpfile} | ps2pdf - $pdffile");
 
 789     $self->{"error"} = $form->cleanup();
 
 794   $form->{"tmpfile"} = $pdffile;
 
 803 #### PlainTextTemplate
 
 806 package PlainTextTemplate;
 
 810 @ISA = qw(LaTeXTemplate);
 
 817   return $type->SUPER::new(@_);
 
 821   my ($self, $variable) = @_;
 
 836 #### OpenDocumentTemplate
 
 839 package OpenDocumentTemplate;
 
 847 # use File::Temp qw(:mktemp);
 
 850 @ISA = qw(SimpleTemplate);
 
 857   my $self = $type->SUPER::new(@_);
 
 859   foreach my $module (qw(Archive::Zip Text::Iconv)) {
 
 860     eval("use ${module};");
 
 862       $self->{"form"}->error("The Perl module '${module}' could not be " .
 
 863                              "loaded. Support for OpenDocument templates " .
 
 864                              "does not work without it. Please install your " .
 
 865                              "distribution's package or get the module from " .
 
 866                              "CPAN ( http://www.cpan.org ).");
 
 870   $self->{"rnd"}   = int(rand(1000000));
 
 871   $self->{"iconv"} = Text::Iconv->new($main::dbcharset, "UTF-8");
 
 873   $self->set_tag_style('<%', '%>');
 
 874   $self->{quot_re} = '"';
 
 880   my ($self, $var, $text, $start_tag, $end_tag, @indices) = @_;
 
 882   my ($form, $new_contents) = ($self->{"form"}, "");
 
 884   my $ary = $self->_get_loop_variable($var, 1, @indices);
 
 886   for (my $i = 0; $i < scalar(@{$ary}); $i++) {
 
 887     $form->{"__first__"} = $i == 0;
 
 888     $form->{"__last__"} = ($i + 1) == scalar(@{$ary});
 
 889     $form->{"__odd__"} = (($i + 1) % 2) == 1;
 
 890     $form->{"__counter__"} = $i + 1;
 
 891     my $new_text = $self->parse_block($text, (@indices, $i));
 
 892     return undef unless (defined($new_text));
 
 893     $new_contents .= $start_tag . $new_text . $end_tag;
 
 895   map({ delete($form->{"__${_}__"}); } qw(first last odd counter));
 
 897   return $new_contents;
 
 901   my ($self, $text, $pos, $var, $not) = @_;
 
 904   $pos = 0 unless ($pos);
 
 906   while ($pos < length($text)) {
 
 909     next if (substr($text, $pos - 1, 5) ne '<%');
 
 911     if ((substr($text, $pos + 4, 2) eq 'if') || (substr($text, $pos + 4, 3) eq 'for')) {
 
 914     } elsif ((substr($text, $pos + 4, 4) eq 'else') && (1 == $depth)) {
 
 916         $self->{"error"} = '<%else%> outside of <%if%> / <%ifnot%>.';
 
 920       my $block = substr($text, 0, $pos - 1);
 
 921       substr($text, 0, $pos - 1) = "";
 
 922       $text =~ s!^\<\%[^\%]+\%\>!!;
 
 923       $text = '<%if' . ($not ?  " " : "not ") . $var . '%>' . $text;
 
 925       return ($block, $text);
 
 927     } elsif (substr($text, $pos + 4, 3) eq 'end') {
 
 930         my $block = substr($text, 0, $pos - 1);
 
 931         substr($text, 0, $pos - 1) = "";
 
 932         $text =~ s!^\<\%[^\%]+\%\>!!;
 
 934         return ($block, $text);
 
 943   $main::lxdebug->enter_sub();
 
 945   my ($self, $contents, @indices) = @_;
 
 947   my $new_contents = "";
 
 949   while ($contents ne "") {
 
 950     if (substr($contents, 0, 1) eq "<") {
 
 951       $contents =~ m|^<[^>]+>|;
 
 953       substr($contents, 0, length($&)) = "";
 
 955       if ($tag =~ m|<table:table-row|) {
 
 956         $contents =~ m|^(.*?)(</table:table-row[^>]*>)|;
 
 959         substr($contents, 0, length($1) + length($end_tag)) = "";
 
 961         if ($table_row =~ m|\<\%foreachrow\s+(.*?)\%\>|) {
 
 964           substr($table_row, length($`), length($&)) = "";
 
 966           my ($t1, $t2) = $self->find_end($table_row, length($`));
 
 968             $self->{"error"} = "Unclosed <\%foreachrow\%>." unless ($self->{"error"});
 
 969             $main::lxdebug->leave_sub();
 
 973           my $new_text = $self->parse_foreach($var, $t1 . $t2, $tag, $end_tag, @indices);
 
 974           if (!defined($new_text)) {
 
 975             $main::lxdebug->leave_sub();
 
 978           $new_contents .= $new_text;
 
 981           my $new_text = $self->parse_block($table_row, @indices);
 
 982           if (!defined($new_text)) {
 
 983             $main::lxdebug->leave_sub();
 
 986           $new_contents .= $tag . $new_text . $end_tag;
 
 990         $new_contents .= $tag;
 
 994       $contents =~ /^[^<]+/;
 
 997       my $pos_if = index($text, '<%if');
 
 998       my $pos_foreach = index($text, '<%foreach');
 
1000       if ((-1 == $pos_if) && (-1 == $pos_foreach)) {
 
1001         substr($contents, 0, length($text)) = "";
 
1002         $new_contents .= $self->substitute_vars($text, @indices);
 
1006       if ((-1 == $pos_if) || ((-1 != $pos_foreach) && ($pos_if > $pos_foreach))) {
 
1007         $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_foreach), @indices);
 
1008         substr($contents, 0, $pos_foreach) = "";
 
1010         if ($contents !~ m|^\<\%foreach (.*?)\%\>|) {
 
1011           $self->{"error"} = "Malformed <\%foreach\%>.";
 
1012           $main::lxdebug->leave_sub();
 
1018         substr($contents, 0, length($&)) = "";
 
1021         ($block, $contents) = $self->find_end($contents);
 
1023           $self->{"error"} = "Unclosed <\%foreach\%>." unless ($self->{"error"});
 
1024           $main::lxdebug->leave_sub();
 
1028         my $new_text = $self->parse_foreach($var, $block, "", "", @indices);
 
1029         if (!defined($new_text)) {
 
1030           $main::lxdebug->leave_sub();
 
1033         $new_contents .= $new_text;
 
1036         if (!$self->_parse_block_if(\$contents, \$new_contents, $pos_if, @indices)) {
 
1037           $main::lxdebug->leave_sub();
 
1044   $main::lxdebug->leave_sub();
 
1046   return $new_contents;
 
1050   $main::lxdebug->enter_sub();
 
1054   my $form = $self->{"form"};
 
1059   if ($form->{"IN"} =~ m|^/|) {
 
1060     $file_name = $form->{"IN"};
 
1062     $file_name = $form->{"templates"} . "/" . $form->{"IN"};
 
1065   my $zip = Archive::Zip->new();
 
1066   if (Archive::Zip->AZ_OK != $zip->read($file_name)) {
 
1067     $self->{"error"} = "File not found/is not a OpenDocument file.";
 
1068     $main::lxdebug->leave_sub();
 
1072   my $contents = $zip->contents("content.xml");
 
1074     $self->{"error"} = "File is not a OpenDocument file.";
 
1075     $main::lxdebug->leave_sub();
 
1079   my $rnd = $self->{"rnd"};
 
1080   my $new_styles = qq|<style:style style:name="TLXO${rnd}BOLD" style:family="text">
 
1081 <style:text-properties fo:font-weight="bold" style:font-weight-asian="bold" style:font-weight-complex="bold"/>
 
1083 <style:style style:name="TLXO${rnd}ITALIC" style:family="text">
 
1084 <style:text-properties fo:font-style="italic" style:font-style-asian="italic" style:font-style-complex="italic"/>
 
1086 <style:style style:name="TLXO${rnd}UNDERLINE" style:family="text">
 
1087 <style:text-properties style:text-underline-style="solid" style:text-underline-width="auto" style:text-underline-color="font-color"/>
 
1089 <style:style style:name="TLXO${rnd}STRIKETHROUGH" style:family="text">
 
1090 <style:text-properties style:text-line-through-style="solid"/>
 
1092 <style:style style:name="TLXO${rnd}SUPER" style:family="text">
 
1093 <style:text-properties style:text-position="super 58%"/>
 
1095 <style:style style:name="TLXO${rnd}SUB" style:family="text">
 
1096 <style:text-properties style:text-position="sub 58%"/>
 
1100   $contents =~ s|</office:automatic-styles>|${new_styles}</office:automatic-styles>|;
 
1101   $contents =~ s|[\n\r]||gm;
 
1103   my $new_contents = $self->parse_block($contents);
 
1104   if (!defined($new_contents)) {
 
1105     $main::lxdebug->leave_sub();
 
1109 #   $new_contents =~ s|>|>\n|g;
 
1111   $zip->contents("content.xml", $new_contents);
 
1113   my $styles = $zip->contents("styles.xml");
 
1115     my $new_styles = $self->parse_block($styles);
 
1116     if (!defined($new_contents)) {
 
1117       $main::lxdebug->leave_sub();
 
1120     $zip->contents("styles.xml", $new_styles);
 
1123   $zip->writeToFileNamed($form->{"tmpfile"}, 1);
 
1126   if ($form->{"format"} =~ /pdf/) {
 
1127     $res = $self->convert_to_pdf();
 
1130   $main::lxdebug->leave_sub();
 
1134 sub is_xvfb_running {
 
1135   $main::lxdebug->enter_sub();
 
1140   my $dfname = $self->{"userspath"} . "/xvfb_display";
 
1143   $main::lxdebug->message(LXDebug->DEBUG2(), "    Looking for $dfname\n");
 
1144   if ((-f $dfname) && open(IN, $dfname)) {
 
1149     my $xauthority = <IN>;
 
1153     $main::lxdebug->message(LXDebug->DEBUG2(), "      found with $pid and $display\n");
 
1155     if ((! -d "/proc/$pid") || !open(IN, "/proc/$pid/cmdline")) {
 
1156       $main::lxdebug->message(LXDebug->DEBUG2(), "  no/wrong process #1\n");
 
1157       unlink($dfname, $xauthority);
 
1158       $main::lxdebug->leave_sub();
 
1163     if ($line !~ /xvfb/i) {
 
1164       $main::lxdebug->message(LXDebug->DEBUG2(), "      no/wrong process #2\n");
 
1165       unlink($dfname, $xauthority);
 
1166       $main::lxdebug->leave_sub();
 
1170     $ENV{"XAUTHORITY"} = $xauthority;
 
1171     $ENV{"DISPLAY"} = $display;
 
1173     $main::lxdebug->message(LXDebug->DEBUG2(), "      not found\n");
 
1176   $main::lxdebug->leave_sub();
 
1182   $main::lxdebug->enter_sub();
 
1186   $main::lxdebug->message(LXDebug->DEBUG2, "spawn_xvfb()\n");
 
1188   my $display = $self->is_xvfb_running();
 
1191     $main::lxdebug->leave_sub();
 
1196   while ( -f "/tmp/.X${display}-lock") {
 
1199   $display = ":${display}";
 
1200   $main::lxdebug->message(LXDebug->DEBUG2(), "  display $display\n");
 
1202   my $mcookie = `mcookie`;
 
1203   die("Installation error: mcookie not found.") if ($? != 0);
 
1206   $main::lxdebug->message(LXDebug->DEBUG2(), "  mcookie $mcookie\n");
 
1208   my $xauthority = "/tmp/.Xauthority-" . $$ . "-" . time() . "-" . int(rand(9999999));
 
1209   $ENV{"XAUTHORITY"} = $xauthority;
 
1211   $main::lxdebug->message(LXDebug->DEBUG2(), "  xauthority $xauthority\n");
 
1213   system("xauth add \"${display}\" . \"${mcookie}\"");
 
1215     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started (xauth: $!)";
 
1216     $main::lxdebug->leave_sub();
 
1220   $main::lxdebug->message(LXDebug->DEBUG2(), "  about to fork()\n");
 
1224     $main::lxdebug->message(LXDebug->DEBUG2(), "  Child execing\n");
 
1225     exec($main::xvfb_bin, $display, "-screen", "0", "640x480x8", "-nolisten", "tcp");
 
1228   $main::lxdebug->message(LXDebug->DEBUG2(), "  parent dont sleeping\n");
 
1231   my $dfname = $self->{"userspath"} . "/xvfb_display";
 
1232   if (!open(OUT, ">$dfname")) {
 
1233     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started ($dfname: $!)";
 
1234     unlink($xauthority);
 
1236     $main::lxdebug->leave_sub();
 
1239   print(OUT "$pid\n$display\n$xauthority\n");
 
1242   $main::lxdebug->message(LXDebug->DEBUG2(), "  parent re-testing\n");
 
1244   if (!$self->is_xvfb_running()) {
 
1245     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started.";
 
1246     unlink($xauthority, $dfname);
 
1248     $main::lxdebug->leave_sub();
 
1252   $main::lxdebug->message(LXDebug->DEBUG2(), "  spawn OK\n");
 
1254   $main::lxdebug->leave_sub();
 
1259 sub is_openoffice_running {
 
1260   $main::lxdebug->enter_sub();
 
1262   system("./scripts/oo-uno-test-conn.py $main::openofficeorg_daemon_port " .
 
1263          "> /dev/null 2> /dev/null");
 
1265   $main::lxdebug->message(LXDebug->DEBUG2(), "  is_openoffice_running(): $?\n");
 
1267   $main::lxdebug->leave_sub();
 
1272 sub spawn_openoffice {
 
1273   $main::lxdebug->enter_sub();
 
1277   $main::lxdebug->message(LXDebug->DEBUG2(), "spawn_openoffice()\n");
 
1279   my ($try, $spawned_oo, $res);
 
1282   for ($try = 0; $try < 15; $try++) {
 
1283     if ($self->is_openoffice_running()) {
 
1291         $main::lxdebug->message(LXDebug->DEBUG2(), "  Child daemonizing\n");
 
1293         open(STDIN, '/dev/null');
 
1294         open(STDOUT, '>/dev/null');
 
1295         my $new_pid = fork();
 
1297         my $ssres = setsid();
 
1298         $main::lxdebug->message(LXDebug->DEBUG2(), "  Child execing\n");
 
1299         my @cmdline = ($main::openofficeorg_writer_bin,
 
1300                        "-minimized", "-norestore", "-nologo", "-nolockcheck",
 
1302                        "-accept=socket,host=localhost,port=" .
 
1303                        $main::openofficeorg_daemon_port . ";urp;");
 
1307       $main::lxdebug->message(LXDebug->DEBUG2(), "  Parent after fork\n");
 
1312     sleep($try >= 5 ? 2 : 1);
 
1316     $self->{"error"} = "Conversion from OpenDocument to PDF failed because " .
 
1317       "OpenOffice could not be started.";
 
1320   $main::lxdebug->leave_sub();
 
1325 sub convert_to_pdf {
 
1326   $main::lxdebug->enter_sub();
 
1330   my $form = $self->{"form"};
 
1332   my $filename = $form->{"tmpfile"};
 
1333   $filename =~ s/.odt$//;
 
1334   if (substr($filename, 0, 1) ne "/") {
 
1335     $filename = getcwd() . "/${filename}";
 
1338   if (substr($self->{"userspath"}, 0, 1) eq "/") {
 
1339     $ENV{'HOME'} = $self->{"userspath"};
 
1341     $ENV{'HOME'} = getcwd() . "/" . $self->{"userspath"};
 
1344   if (!$self->spawn_xvfb()) {
 
1345     $main::lxdebug->leave_sub();
 
1350   if (!$main::openofficeorg_daemon) {
 
1351     @cmdline = ($main::openofficeorg_writer_bin,
 
1352                 "-minimized", "-norestore", "-nologo", "-nolockcheck",
 
1354                 "file:${filename}.odt",
 
1355                 "macro://" . (split('/', $filename))[-1] .
 
1356                 "/Standard.Conversion.ConvertSelfToPDF()");
 
1358     if (!$self->spawn_openoffice()) {
 
1359       $main::lxdebug->leave_sub();
 
1363     @cmdline = ("./scripts/oo-uno-convert-pdf.py",
 
1364                 $main::openofficeorg_daemon_port,
 
1372     $form->{"tmpfile"} =~ s/odt$/pdf/;
 
1374     unlink($filename . ".odt");
 
1376     $main::lxdebug->leave_sub();
 
1381   unlink($filename . ".odt", $filename . ".pdf");
 
1382   $self->{"error"} = "Conversion from OpenDocument to PDF failed. " .
 
1385   $main::lxdebug->leave_sub();
 
1390   my ($self, $variable) = @_;
 
1391   my $form = $self->{"form"};
 
1392   my $iconv = $self->{"iconv"};
 
1394   $variable = $main::locale->quote_special_chars('Template/OpenDocument', $variable);
 
1396   # Allow some HTML markup to be converted into the output format's
 
1397   # corresponding markup code, e.g. bold or italic.
 
1398   my $rnd = $self->{"rnd"};
 
1399   my %markup_replace = ("b" => "BOLD", "i" => "ITALIC", "s" => "STRIKETHROUGH",
 
1400                         "u" => "UNDERLINE", "sup" => "SUPER", "sub" => "SUB");
 
1402   foreach my $key (keys(%markup_replace)) {
 
1403     my $value = $markup_replace{$key};
 
1404     $variable =~ s|\<${key}\>|<text:span text:style-name=\"TLXO${rnd}${value}\">|gi; #"
 
1405     $variable =~ s|\</${key}\>|</text:span>|gi;
 
1408   return $iconv->convert($variable);
 
1411 sub get_mime_type() {
 
1414   if ($self->{"form"}->{"format"} =~ /pdf/) {
 
1415     return "application/pdf";
 
1417     return "application/vnd.oasis.opendocument.text";
 
1421 sub uses_temp_file {
 
1426 ##########################################################
 
1430 ##########################################################
 
1432 package XMLTemplate;
 
1436 @ISA = qw(HTMLTemplate);
 
1441   #evtl auskommentieren
 
1444   return $type->SUPER::new(@_);
 
1448   my ($self, $variable) = @_;
 
1449   my $form = $self->{"form"};
 
1451   $variable = $main::locale->quote_special_chars('Template/XML', $variable);
 
1453   # Allow no markup to be converted into the output format
 
1454   my @markup_replace = ('b', 'i', 's', 'u', 'sub', 'sup');
 
1456   foreach my $key (@markup_replace) {
 
1457     $variable =~ s/\<(\/?)${key}\>//g;
 
1463 sub get_mime_type() {
 
1466   if ($self->{"form"}->{"format"} =~ /elsterwinston/i) {
 
1467     return "application/xml ";
 
1468   } elsif ($self->{"form"}->{"format"} =~ /elstertaxbird/i) {
 
1469     return "application/x-taxbird";
 
1475 sub uses_temp_file {
 
1476   # tempfile needet for XML Output