Bugfixes für und Erweiterung der Vergleichsmöglichkeiten in <%if...%>.
[kivitendo-erp.git] / SL / Template.pm
1 #====================================================================
2 # LX-Office ERP
3 # Copyright (C) 2004
4 # Based on SQL-Ledger Version 2.1.9
5 # Web http://www.lx-office.org
6 #
7 #====================================================================
8
9 package SimpleTemplate;
10
11 # Parameters:
12 #   1. The template's file name
13 #   2. A reference to the Form object
14 #   3. A reference to the myconfig hash
15 #
16 # Returns:
17 #   A new template object
18 sub new {
19   my $type = shift;
20   my $self = {};
21
22   bless($self, $type);
23   $self->_init(@_);
24
25   return $self;
26 }
27
28 sub _init {
29   my $self = shift;
30
31   $self->{source}    = shift;
32   $self->{form}      = shift;
33   $self->{myconfig}  = shift;
34   $self->{userspath} = shift;
35
36   $self->{error}     = undef;
37
38   $self->set_tag_style('<%', '%>');
39 }
40
41 sub set_tag_style {
42   my $self                    = shift;
43   my $tag_start               = shift;
44   my $tag_end                 = shift;
45
46   $self->{tag_start}          = $tag_start;
47   $self->{tag_end}            = $tag_end;
48   $self->{tag_start_qm}       = quotemeta $tag_start;
49   $self->{tag_end_qm}         = quotemeta $tag_end;
50
51   $self->{substitute_vars_re} = "$self->{tag_start_qm}(.+?)$self->{tag_end_qm}";
52 }
53
54 sub cleanup {
55   my ($self) = @_;
56 }
57
58 # Parameters:
59 #   1. A typeglob for the file handle. The output will be written
60 #      to this file handle.
61 #
62 # Returns:
63 #   1 on success and undef or 0 if there was an error. In the latter case
64 #   the calling function can retrieve the error message via $obj->get_error()
65 sub parse {
66   my $self = $_[0];
67   local *OUT = $_[1];
68
69   print(OUT "Hallo!\n");
70 }
71
72 sub get_error {
73   my $self = shift;
74
75   return $self->{"error"};
76 }
77
78 sub uses_temp_file {
79   return 0;
80 }
81
82 sub _get_loop_variable {
83   my $self      = shift;
84   my $var       = shift;
85   my $get_array = shift;
86   my @indices   = @_;
87
88   my $form      = $self->{form};
89   my $value;
90
91   if (($get_array || @indices) && (ref $form->{TEMPLATE_ARRAYS} eq 'HASH') && (ref $form->{TEMPLATE_ARRAYS}->{$var} eq 'ARRAY')) {
92     $value = $form->{TEMPLATE_ARRAYS}->{$var};
93   } else {
94     $value = $form->{$var};
95   }
96
97   for (my $i = 0; $i < scalar(@indices); $i++) {
98     last unless (ref($value) eq "ARRAY");
99     $value = $value->[$indices[$i]];
100   }
101
102   return $value;
103 }
104
105 sub substitute_vars {
106   my ($self, $text, @indices) = @_;
107
108   my $form = $self->{"form"};
109
110   while ($text =~ /$self->{substitute_vars_re}/) {
111     my ($tag_pos, $tag_len) = ($-[0], $+[0] - $-[0]);
112     my ($var, @options)     = split(/\s+/, $1);
113
114     my $value               = $self->_get_loop_variable($var, 0, @indices);
115     $value                  = $self->format_string($value) unless (grep(/^NOESCAPE$/, @options));
116
117     substr($text, $tag_pos, $tag_len, $value);
118   }
119
120   return $text;
121 }
122
123 1;
124
125 ####
126 #### LaTeXTemplate
127 ####
128
129 package LaTeXTemplate;
130
131 use vars qw(@ISA);
132
133 @ISA = qw(SimpleTemplate);
134
135 sub new {
136   my $type = shift;
137
138   my $self = $type->SUPER::new(@_);
139
140   return $self;
141 }
142
143 sub format_string {
144   my ($self, $variable) = @_;
145   my $form = $self->{"form"};
146
147   $variable = $main::locale->quote_special_chars('Template/LaTeX', $variable);
148
149   # Allow some HTML markup to be converted into the output format's
150   # corresponding markup code, e.g. bold or italic.
151   my %markup_replace = ('b' => 'textbf',
152                         'i' => 'textit',
153                         'u' => 'underline');
154
155   foreach my $key (keys(%markup_replace)) {
156     my $new = $markup_replace{$key};
157     $variable =~ s/\$\<\$${key}\$\>\$(.*?)\$<\$\/${key}\$>\$/\\${new}\{$1\}/gi;
158   }
159
160   $variable =~ s/[\x00-\x1f]//g;
161
162   return $variable;
163 }
164
165 sub parse_foreach {
166   my ($self, $var, $text, $start_tag, $end_tag, @indices) = @_;
167
168   my ($form, $new_contents) = ($self->{"form"}, "");
169
170   my $ary = $self->_get_loop_variable($var, 1, @indices);
171
172   my $sum                          = 0;
173   my $current_page                 = 1;
174   my ($current_line, $corrent_row) = (0, 1);
175   my $description_array            = $self->_get_loop_variable("description",     1);
176   my $longdescription_array        = $self->_get_loop_variable("longdescription", 1);
177   my $linetotal_array              = $self->_get_loop_variable("linetotal",       1);
178
179   $form->{TEMPLATE_ARRAYS}->{cumulatelinetotal} = [];
180
181   for (my $i = 0; $i < scalar(@{$ary}); $i++) {
182     $form->{"__first__"}   = $i == 1;
183     $form->{"__last__"}    = ($i + 1) == scalar(@{$ary});
184     $form->{"__odd__"}     = (($i + 1) % 2) == 1;
185     $form->{"__counter__"} = $i + 1;
186
187     if (scalar @{$description_array} == scalar @{$ary} && $self->{"chars_per_line"} != 0) {
188       my $lines = int(length($description_array->[$i]) / $self->{"chars_per_line"});
189       my $lpp;
190
191       $description_array->[$i] =~ s/(\\newline\s?)*$//;
192       my $_description = $description_array->[$i];
193       while ($_description =~ /\\newline/) {
194         $lines++;
195         $_description =~ s/\\newline//;
196       }
197       $lines++;
198
199       if ($current_page == 1) {
200         $lpp = $self->{"lines_on_first_page"};
201       } else {
202         $lpp = $self->{"lines_on_second_page"};
203       }
204
205       # Yes we need a manual page break -- or the user has forced one
206       if ((($current_line + $lines) > $lpp) || ($description_array->[$i] =~ /<pagebreak>/) || ($longdescription_array->[$i] =~ /<pagebreak>/)) {
207         my $pb = $self->{"pagebreak_block"};
208
209         # replace the special variables <%sumcarriedforward%>
210         # and <%lastpage%>
211
212         my $psum = $form->format_amount($self->{"myconfig"}, $sum, 2);
213         $pb =~ s/$self->{tag_start_qm}sumcarriedforward$self->{tag_end_qm}/$psum/g;
214         $pb =~ s/$self->{tag_start_qm}lastpage$self->{tag_end_qm}/$current_page/g;
215
216         my $new_text = $self->parse_block($pb, (@indices, $i));
217         return undef unless (defined($new_text));
218         $new_contents .= $new_text;
219
220         $current_page++;
221         $current_line = 0;
222       }
223       $current_line += $lines;
224     }
225
226     if ($i < scalar(@{$linetotal_array})) {
227       $sum += $form->parse_amount($self->{"myconfig"}, $linetotal_array->[$i]);
228     }
229
230     $form->{TEMPLATE_ARRAYS}->{cumulatelinetotal}->[$i] = $form->format_amount($self->{"myconfig"}, $sum, 2);
231
232     my $new_text = $self->parse_block($text, (@indices, $i));
233     return undef unless (defined($new_text));
234     $new_contents .= $start_tag . $new_text . $end_tag;
235   }
236   map({ delete($form->{"__${_}__"}); } qw(first last odd counter));
237
238   return $new_contents;
239 }
240
241 sub find_end {
242   my ($self, $text, $pos, $var, $not) = @_;
243
244   my $tag_start_len = length $self->{tag_start};
245
246   my $depth = 1;
247   $pos = 0 unless ($pos);
248
249   while ($pos < length($text)) {
250     $pos++;
251
252     next if (substr($text, $pos - 1, length($self->{tag_start})) ne $self->{tag_start});
253
254     my $keyword_pos = $pos - 1 + $tag_start_len;
255
256     if ((substr($text, $keyword_pos, 2) eq 'if') || (substr($text, $keyword_pos, 3) eq 'for')) {
257       $depth++;
258
259     } elsif ((substr($text, $keyword_pos, 4) eq 'else') && (1 == $depth)) {
260       if (!$var) {
261         $self->{"error"} =
262             "$self->{tag_start}else$self->{tag_end} outside of "
263           . "$self->{tag_start}if$self->{tag_end} / "
264           . "$self->{tag_start}ifnot$self->{tag_end}.";
265         return undef;
266       }
267
268       my $block = substr($text, 0, $pos - 1);
269       substr($text, 0, $pos - 1) = "";
270       $text =~ s!^$self->{tag_start_qm}.+?$self->{tag_end_qm}!!;
271       $text =  $self->{tag_start} . 'if' . ($not ?  " " : "not ") . $var . $self->{tag_end} . $text;
272
273       return ($block, $text);
274
275     } elsif (substr($text, $keyword_pos, 3) eq 'end') {
276       $depth--;
277       if ($depth == 0) {
278         my $block = substr($text, 0, $pos - 1);
279         substr($text, 0, $pos - 1) = "";
280         $text =~ s!^$self->{tag_start_qm}.+?$self->{tag_end_qm}!!;
281
282         return ($block, $text);
283       }
284     }
285   }
286
287   return undef;
288 }
289
290 sub parse_block {
291   $main::lxdebug->enter_sub();
292
293   my ($self, $contents, @indices) = @_;
294
295   my $new_contents = "";
296
297   while ($contents ne "") {
298     my $pos_if      = index($contents, $self->{tag_start} . 'if');
299     my $pos_foreach = index($contents, $self->{tag_start} . 'foreach');
300
301     if ((-1 == $pos_if) && (-1 == $pos_foreach)) {
302       $new_contents .= $self->substitute_vars($contents, @indices);
303       last;
304     }
305
306     if ((-1 == $pos_if) || ((-1 != $pos_foreach) && ($pos_if > $pos_foreach))) {
307       $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_foreach), @indices);
308       substr($contents, 0, $pos_foreach) = "";
309
310       if ($contents !~ m|^$self->{tag_start_qm}foreach (.+?)$self->{tag_end_qm}|) {
311         $self->{"error"} = "Malformed $self->{tag_start}foreach$self->{tag_end}.";
312         $main::lxdebug->leave_sub();
313         return undef;
314       }
315
316       my $var = $1;
317
318       substr($contents, 0, length($&)) = "";
319
320       my $block;
321       ($block, $contents) = $self->find_end($contents);
322       if (!$block) {
323         $self->{"error"} = "Unclosed $self->{tag_start}foreach$self->{tag_end}." unless ($self->{"error"});
324         $main::lxdebug->leave_sub();
325         return undef;
326       }
327
328       my $new_text = $self->parse_foreach($var, $block, "", "", @indices);
329       if (!defined($new_text)) {
330         $main::lxdebug->leave_sub();
331         return undef;
332       }
333       $new_contents .= $new_text;
334
335     } else {
336       $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_if), @indices);
337       substr($contents, 0, $pos_if) = "";
338
339       if ($contents !~ m/^$self->{tag_start_qm}if
340                          \s*
341                          (not\b|\!)?         # $1 -- Eventuelle Negierung
342                          \s+
343                          (\b.+?\b)           # $2 -- Name der zu überprüfenden Variablen
344                          (                   # $3 -- Beginn des optionalen Vergleiches
345                            \s*
346                            ([!=])            # $4 -- Negierung des Vergleiches speichern
347                            ([=~])            # $5 -- Art des Vergleiches speichern
348                            \s*
349                            (                 # $6 -- Gequoteter String oder Bareword
350                              "(.*?)(?<!\\)"  # $7 -- Gequoteter String -- direkter Vergleich mit eq bzw. ne oder Patternmatching; Escapete Anführungs als Teil des Strings belassen
351                            |
352                              (\b.+?\b)       # $8 -- Bareword -- als Index für $form benutzen
353                            )
354                          )?
355                          \s*
356                          $self->{tag_end_qm}
357                         /x) {
358         $self->{"error"} = "Malformed $self->{tag_start}if$self->{tag_end}.";
359         $main::lxdebug->leave_sub();
360         return undef;
361       }
362
363       my $not           = $1;
364       my $var           = $2;
365       my $operator_neg  = $4; # '=' oder '!' oder undef, wenn kein Vergleich erkannt
366       my $operator_type = $5; # '=' oder '~' für Stringvergleich oder Regex
367       my $quoted_word   = $7; # nur gültig, wenn quoted string angegeben (siehe unten); dann "value" aus <%if var == "value" %>
368       my $bareword      = $8; # undef, falls quoted string angegeben wurde; andernfalls "othervar" aus <%if var == othervar %>
369
370       $not = !$not if ($operator_neg && $operator_neg eq '!');
371
372       substr($contents, 0, length($&)) = "";
373
374       ($block, $contents) = $self->find_end($contents, 0, $var, $not);
375       if (!$block) {
376         $self->{"error"} = "Unclosed $self->{tag_start}if${not}$self->{tag_end}." unless ($self->{"error"});
377         $main::lxdebug->leave_sub();
378         return undef;
379       }
380
381       my $value = $self->_get_loop_variable($var, 0, @indices);
382       my $hit   = 0;
383
384       if ($operator_type) {
385         my $compare_to = $bareword ? $self->_get_loop_variable($bareword, 0, @indices) : $quoted_word;
386         if ($operator_type eq '=') {
387           $hit         = ($not && !($value eq $compare_to))    || (!$not && ($value eq $compare_to));
388         } else {
389           $hit         = ($not && !($value =~ m/$compare_to/)) || (!$not && ($value =~ m/$compare_to/));
390         }
391
392       } else {
393         $hit           = ($not && ! $value)                    || (!$not &&  $value);
394       }
395
396       if ($hit) {
397         my $new_text = $self->parse_block($block, @indices);
398         if (!defined($new_text)) {
399           $main::lxdebug->leave_sub();
400           return undef;
401         }
402         $new_contents .= $new_text;
403       }
404     }
405   }
406
407   $main::lxdebug->leave_sub();
408
409   return $new_contents;
410 }
411
412 sub parse_first_line {
413   my $self = shift;
414   my $line = shift || "";
415
416   if ($line =~ m/([^\s]+)set-tag-style([^\s]+)/) {
417     if ($1 eq $2) {
418       $self->{error} = "The tag start and end markers must not be equal.";
419       return 0;
420     }
421
422     $self->set_tag_style($1, $2);
423   }
424
425   return 1;
426 }
427
428 sub _parse_config_option {
429   my $self = shift;
430   my $line = shift;
431
432   $line =~ s/^\s*//;
433   $line =~ s/\s*$//;
434
435   my ($key, $value) = split m/\s*=\s*/, $line, 2;
436
437   if ($key eq 'tag-style') {
438     $self->set_tag_style(split(m/\s+/, $value, 2));
439   }
440 }
441
442 sub _parse_config_lines {
443   my $self  = shift;
444   my $lines = shift;
445
446   my ($comment_start, $comment_end) = ("", "");
447
448   if (ref $self eq 'LaTeXTemplate') {
449     $comment_start = '\s*%';
450   } elsif (ref $self eq 'HTMLTemplate') {
451     $comment_start = '\s*<!--';
452     $comment_end   = '>\s*';
453   } else {
454     $comment_start = '\s*\#';
455   }
456
457   my $num_lines = scalar @{ $lines };
458   my $i         = 0;
459
460   while ($i < $num_lines) {
461     my $line = $lines->[$i];
462
463     if ($line !~ m/^${comment_start}\s*config\s*:(.*)${comment_end}$/i) {
464       $i++;
465       next;
466     }
467
468     $self->_parse_config_option($1);
469     splice @{ $lines }, $i, 1;
470     $num_lines--;
471   }
472 }
473
474 sub _force_mandatory_packages {
475   my $self  = shift;
476   my $lines = shift;
477
478   my (%used_packages, $document_start_line);
479
480   foreach my $i (0 .. scalar @{ $lines } - 1) {
481     if ($lines->[$i] =~ m/\\usepackage[^{]*{(.*?)}/) {
482       $used_packages{$1} = 1;
483
484     } elsif ($lines->[$i] =~ m/\\begin{document}/) {
485       $document_start_line = $i;
486       last;
487
488     }
489   }
490
491   $document_start_line = scalar @{ $lines } - 1 if (!defined $document_start_line);
492
493   if (!$used_packages{textcomp}) {
494     splice @{ $lines }, $document_start_line, 0, "\\usepackage{textcomp}\n";
495     $document_start_line++;
496   }
497 }
498
499 sub parse {
500   my $self = $_[0];
501   local *OUT = $_[1];
502   my $form = $self->{"form"};
503
504   if (!open(IN, "$form->{templates}/$form->{IN}")) {
505     $self->{"error"} = "$!";
506     return 0;
507   }
508   my @lines = <IN>;
509   close(IN);
510
511   $self->_parse_config_lines(\@lines);
512   $self->_force_mandatory_packages(\@lines) if (ref $self eq 'LaTeXTemplate');
513
514   my $contents = join("", @lines);
515
516   # detect pagebreak block and its parameters
517   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) {
518     $self->{"chars_per_line"} = $1;
519     $self->{"lines_on_first_page"} = $2;
520     $self->{"lines_on_second_page"} = $3;
521     $self->{"pagebreak_block"} = $4;
522
523     substr($contents, length($`), length($&)) = "";
524   }
525
526   $self->{"forced_pagebreaks"} = [];
527
528   my $new_contents = $self->parse_block($contents);
529   if (!defined($new_contents)) {
530     $main::lxdebug->leave_sub();
531     return 0;
532   }
533
534   print(OUT $new_contents);
535
536   if ($form->{"format"} =~ /postscript/i) {
537     return $self->convert_to_postscript();
538   } elsif ($form->{"format"} =~ /pdf/i) {
539     return $self->convert_to_pdf();
540   } else {
541     return 1;
542   }
543 }
544
545 sub convert_to_postscript {
546   my ($self) = @_;
547   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
548
549   # Convert the tex file to postscript
550
551   if (!chdir("$userspath")) {
552     $self->{"error"} = "chdir : $!";
553     $self->cleanup();
554     return 0;
555   }
556
557   $form->{tmpfile} =~ s/\Q$userspath\E\///g;
558
559   my $latex = $self->_get_latex_path();
560
561   for (my $run = 1; $run <= 2; $run++) {
562     system("${latex} --interaction=nonstopmode $form->{tmpfile} " .
563            "> $form->{tmpfile}.err");
564     if ($?) {
565       $self->{"error"} = $form->cleanup();
566       $self->cleanup();
567       return 0;
568     }
569   }
570
571   $form->{tmpfile} =~ s/tex$/dvi/;
572
573   system("dvips $form->{tmpfile} -o -q > /dev/null");
574   if ($?) {
575     $self->{"error"} = "dvips : $!";
576     $self->cleanup();
577     return 0;
578   }
579   $form->{tmpfile} =~ s/dvi$/ps/;
580
581   $self->cleanup();
582
583   return 1;
584 }
585
586 sub convert_to_pdf {
587   my ($self) = @_;
588   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
589
590   # Convert the tex file to PDF
591
592   if (!chdir("$userspath")) {
593     $self->{"error"} = "chdir : $!";
594     $self->cleanup();
595     return 0;
596   }
597
598   $form->{tmpfile} =~ s/\Q$userspath\E\///g;
599
600   my $latex = $self->_get_latex_path();
601
602   for (my $run = 1; $run <= 2; $run++) {
603     system("${latex} --interaction=nonstopmode $form->{tmpfile} " .
604            "> $form->{tmpfile}.err");
605     if ($?) {
606       $self->{"error"} = $form->cleanup();
607       $self->cleanup();
608       return 0;
609     }
610   }
611
612   $form->{tmpfile} =~ s/tex$/pdf/;
613
614   $self->cleanup();
615 }
616
617 sub _get_latex_path {
618   return $main::latex_bin || 'pdflatex';
619 }
620
621 sub get_mime_type() {
622   my ($self) = @_;
623
624   if ($self->{"form"}->{"format"} =~ /postscript/i) {
625     return "application/postscript";
626   } else {
627     return "application/pdf";
628   }
629 }
630
631 sub uses_temp_file {
632   return 1;
633 }
634
635
636 ####
637 #### HTMLTemplate
638 ####
639
640 package HTMLTemplate;
641
642 use vars qw(@ISA);
643
644 @ISA = qw(LaTeXTemplate);
645
646 sub new {
647   my $type = shift;
648
649   return $type->SUPER::new(@_);
650 }
651
652 sub format_string {
653   my ($self, $variable) = @_;
654   my $form = $self->{"form"};
655
656   $variable = $main::locale->quote_special_chars('Template/HTML', $variable);
657
658   # Allow some HTML markup to be converted into the output format's
659   # corresponding markup code, e.g. bold or italic.
660   my @markup_replace = ('b', 'i', 's', 'u', 'sub', 'sup');
661
662   foreach my $key (@markup_replace) {
663     $variable =~ s/\&lt;(\/?)${key}\&gt;/<$1${key}>/g;
664   }
665
666   return $variable;
667 }
668
669 sub get_mime_type() {
670   my ($self) = @_;
671
672   if ($self->{"form"}->{"format"} =~ /postscript/i) {
673     return "application/postscript";
674   } elsif ($self->{"form"}->{"format"} =~ /pdf/i) {
675     return "application/pdf";
676   } else {
677     return "text/html";
678   }
679 }
680
681 sub uses_temp_file {
682   my ($self) = @_;
683
684   if ($self->{"form"}->{"format"} =~ /postscript/i) {
685     return 1;
686   } elsif ($self->{"form"}->{"format"} =~ /pdf/i) {
687     return 1;
688   } else {
689     return 0;
690   }
691 }
692
693 sub convert_to_postscript {
694   my ($self) = @_;
695   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
696
697   # Convert the HTML file to postscript
698
699   if (!chdir("$userspath")) {
700     $self->{"error"} = "chdir : $!";
701     $self->cleanup();
702     return 0;
703   }
704
705   $form->{"tmpfile"} =~ s/\Q$userspath\E\///g;
706   my $psfile = $form->{"tmpfile"};
707   $psfile =~ s/.html/.ps/;
708   if ($psfile eq $form->{"tmpfile"}) {
709     $psfile .= ".ps";
710   }
711
712   system("html2ps -f html2ps-config < $form->{tmpfile} > $psfile");
713   if ($?) {
714     $self->{"error"} = $form->cleanup();
715     $self->cleanup();
716     return 0;
717   }
718
719   $form->{"tmpfile"} = $psfile;
720
721   $self->cleanup();
722
723   return 1;
724 }
725
726 sub convert_to_pdf {
727   my ($self) = @_;
728   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
729
730   # Convert the HTML file to PDF
731
732   if (!chdir("$userspath")) {
733     $self->{"error"} = "chdir : $!";
734     $self->cleanup();
735     return 0;
736   }
737
738   $form->{"tmpfile"} =~ s/\Q$userspath\E\///g;
739   my $pdffile = $form->{"tmpfile"};
740   $pdffile =~ s/.html/.pdf/;
741   if ($pdffile eq $form->{"tmpfile"}) {
742     $pdffile .= ".pdf";
743   }
744
745   system("html2ps -f html2ps-config < $form->{tmpfile} | ps2pdf - $pdffile");
746   if ($?) {
747     $self->{"error"} = $form->cleanup();
748     $self->cleanup();
749     return 0;
750   }
751
752   $form->{"tmpfile"} = $pdffile;
753
754   $self->cleanup();
755
756   return 1;
757 }
758
759
760 ####
761 #### PlainTextTemplate
762 ####
763
764 package PlainTextTemplate;
765
766 use vars qw(@ISA);
767
768 @ISA = qw(LaTeXTemplate);
769
770 sub new {
771   my $type = shift;
772
773   return $type->SUPER::new(@_);
774 }
775
776 sub format_string {
777   my ($self, $variable) = @_;
778
779   return $variable;
780 }
781
782 sub get_mime_type {
783   return "text/plain";
784 }
785
786 sub parse {
787 }
788
789 1;
790
791 ####
792 #### OpenDocumentTemplate
793 ####
794
795 package OpenDocumentTemplate;
796
797 use POSIX 'setsid';
798 use vars qw(@ISA);
799
800 use Cwd;
801 # use File::Copy;
802 # use File::Spec;
803 # use File::Temp qw(:mktemp);
804 use IO::File;
805
806 @ISA = qw(SimpleTemplate);
807
808 sub new {
809   my $type = shift;
810
811   $self = $type->SUPER::new(@_);
812
813   foreach my $module (qw(Archive::Zip Text::Iconv)) {
814     eval("use ${module};");
815     if ($@) {
816       $self->{"form"}->error("The Perl module '${module}' could not be " .
817                              "loaded. Support for OpenDocument templates " .
818                              "does not work without it. Please install your " .
819                              "distribution's package or get the module from " .
820                              "CPAN ( http://www.cpan.org ).");
821     }
822   }
823
824   $self->{"rnd"}   = int(rand(1000000));
825   $self->{"iconv"} = Text::Iconv->new($main::dbcharset, "UTF-8");
826
827   $self->set_tag_style('&lt;%', '%&gt;');
828
829   return $self;
830 }
831
832 sub parse_foreach {
833   my ($self, $var, $text, $start_tag, $end_tag, @indices) = @_;
834
835   my ($form, $new_contents) = ($self->{"form"}, "");
836
837   my $ary = $self->_get_loop_variable($var, 1, @indices);
838
839   for (my $i = 0; $i < scalar(@{$ary}); $i++) {
840     $form->{"__first__"} = $i == 0;
841     $form->{"__last__"} = ($i + 1) == scalar(@{$ary});
842     $form->{"__odd__"} = (($i + 1) % 2) == 1;
843     $form->{"__counter__"} = $i + 1;
844     my $new_text = $self->parse_block($text, (@indices, $i));
845     return undef unless (defined($new_text));
846     $new_contents .= $start_tag . $new_text . $end_tag;
847   }
848   map({ delete($form->{"__${_}__"}); } qw(first last odd counter));
849
850   return $new_contents;
851 }
852
853 sub find_end {
854   my ($self, $text, $pos, $var, $not) = @_;
855
856   my $depth = 1;
857   $pos = 0 unless ($pos);
858
859   while ($pos < length($text)) {
860     $pos++;
861
862     next if (substr($text, $pos - 1, 5) ne '&lt;%');
863
864     if ((substr($text, $pos + 4, 2) eq 'if') || (substr($text, $pos + 4, 3) eq 'for')) {
865       $depth++;
866
867     } elsif ((substr($text, $pos + 4, 4) eq 'else') && (1 == $depth)) {
868       if (!$var) {
869         $self->{"error"} = '<%else%> outside of <%if%> / <%ifnot%>.';
870         return undef;
871       }
872
873       my $block = substr($text, 0, $pos - 1);
874       substr($text, 0, $pos - 1) = "";
875       $text =~ s!^\&lt;\%[^\%]+\%\&gt;!!;
876       $text = '&lt;%if' . ($not ?  " " : "not ") . $var . '%&gt;' . $text;
877
878       return ($block, $text);
879
880     } elsif (substr($text, $pos + 4, 3) eq 'end') {
881       $depth--;
882       if ($depth == 0) {
883         my $block = substr($text, 0, $pos - 1);
884         substr($text, 0, $pos - 1) = "";
885         $text =~ s!^\&lt;\%[^\%]+\%\&gt;!!;
886
887         return ($block, $text);
888       }
889     }
890   }
891
892   return undef;
893 }
894
895 sub parse_block {
896   $main::lxdebug->enter_sub();
897
898   my ($self, $contents, @indices) = @_;
899
900   my $new_contents = "";
901
902   while ($contents ne "") {
903     if (substr($contents, 0, 1) eq "<") {
904       $contents =~ m|^<[^>]+>|;
905       my $tag = $&;
906       substr($contents, 0, length($&)) = "";
907
908       if ($tag =~ m|<table:table-row|) {
909         $contents =~ m|^(.*?)(</table:table-row[^>]*>)|;
910         my $table_row = $1;
911         my $end_tag = $2;
912         substr($contents, 0, length($1) + length($end_tag)) = "";
913
914         if ($table_row =~ m|\&lt;\%foreachrow\s+(.*?)\%\&gt;|) {
915           my $var = $1;
916
917           substr($table_row, length($`), length($&)) = "";
918
919           my ($t1, $t2) = $self->find_end($table_row, length($`));
920           if (!$t1) {
921             $self->{"error"} = "Unclosed <\%foreachrow\%>." unless ($self->{"error"});
922             $main::lxdebug->leave_sub();
923             return undef;
924           }
925
926           my $new_text = $self->parse_foreach($var, $t1 . $t2, $tag, $end_tag, @indices);
927           if (!defined($new_text)) {
928             $main::lxdebug->leave_sub();
929             return undef;
930           }
931           $new_contents .= $new_text;
932
933         } else {
934           my $new_text = $self->parse_block($table_row, @indices);
935           if (!defined($new_text)) {
936             $main::lxdebug->leave_sub();
937             return undef;
938           }
939           $new_contents .= $tag . $new_text . $end_tag;
940         }
941
942       } else {
943         $new_contents .= $tag;
944       }
945
946     } else {
947       $contents =~ /^[^<]+/;
948       my $text = $&;
949
950       my $pos_if = index($text, '&lt;%if');
951       my $pos_foreach = index($text, '&lt;%foreach');
952
953       if ((-1 == $pos_if) && (-1 == $pos_foreach)) {
954         substr($contents, 0, length($text)) = "";
955         $new_contents .= $self->substitute_vars($text, @indices);
956         next;
957       }
958
959       if ((-1 == $pos_if) || ((-1 != $pos_foreach) && ($pos_if > $pos_foreach))) {
960         $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_foreach), @indices);
961         substr($contents, 0, $pos_foreach) = "";
962
963         if ($contents !~ m|^\&lt;\%foreach (.*?)\%\&gt;|) {
964           $self->{"error"} = "Malformed <\%foreach\%>.";
965           $main::lxdebug->leave_sub();
966           return undef;
967         }
968
969         my $var = $1;
970
971         substr($contents, 0, length($&)) = "";
972
973         my $block;
974         ($block, $contents) = $self->find_end($contents);
975         if (!$block) {
976           $self->{"error"} = "Unclosed <\%foreach\%>." unless ($self->{"error"});
977           $main::lxdebug->leave_sub();
978           return undef;
979         }
980
981         my $new_text = $self->parse_foreach($var, $block, "", "", @indices);
982         if (!defined($new_text)) {
983           $main::lxdebug->leave_sub();
984           return undef;
985         }
986         $new_contents .= $new_text;
987
988       } else {
989         $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_if), @indices);
990         substr($contents, 0, $pos_if) = "";
991
992         if ($contents !~ m|^\&lt;\%if\s*(not)?\s+(.*?)\%\&gt;|) {
993           $self->{"error"} = "Malformed <\%if\%>.";
994           $main::lxdebug->leave_sub();
995           return undef;
996         }
997
998         my ($not, $var) = ($1, $2);
999
1000         substr($contents, 0, length($&)) = "";
1001
1002         ($block, $contents) = $self->find_end($contents, 0, $var, $not);
1003         if (!$block) {
1004           $self->{"error"} = "Unclosed <\%if${not}\%>." unless ($self->{"error"});
1005           $main::lxdebug->leave_sub();
1006           return undef;
1007         }
1008
1009         my $value = $self->{"form"}->{$var};
1010         for (my $i = 0; $i < scalar(@indices); $i++) {
1011           last unless (ref($value) eq "ARRAY");
1012           $value = $value->[$indices[$i]];
1013         }
1014
1015         if (($not && !$value) || (!$not && $value)) {
1016           my $new_text = $self->parse_block($block, @indices);
1017           if (!defined($new_text)) {
1018             $main::lxdebug->leave_sub();
1019             return undef;
1020           }
1021           $new_contents .= $new_text;
1022         }
1023       }
1024     }
1025   }
1026
1027   $main::lxdebug->leave_sub();
1028
1029   return $new_contents;
1030 }
1031
1032 sub parse {
1033   $main::lxdebug->enter_sub();
1034
1035   my $self = $_[0];
1036   local *OUT = $_[1];
1037   my $form = $self->{"form"};
1038
1039   close(OUT);
1040
1041   my $file_name;
1042   if ($form->{"IN"} =~ m|^/|) {
1043     $file_name = $form->{"IN"};
1044   } else {
1045     $file_name = $form->{"templates"} . "/" . $form->{"IN"};
1046   }
1047
1048   my $zip = Archive::Zip->new();
1049   if (Archive::Zip::AZ_OK != $zip->read($file_name)) {
1050     $self->{"error"} = "File not found/is not a OpenDocument file.";
1051     $main::lxdebug->leave_sub();
1052     return 0;
1053   }
1054
1055   my $contents = $zip->contents("content.xml");
1056   if (!$contents) {
1057     $self->{"error"} = "File is not a OpenDocument file.";
1058     $main::lxdebug->leave_sub();
1059     return 0;
1060   }
1061
1062   my $rnd = $self->{"rnd"};
1063   my $new_styles = qq|<style:style style:name="TLXO${rnd}BOLD" style:family="text">
1064 <style:text-properties fo:font-weight="bold" style:font-weight-asian="bold" style:font-weight-complex="bold"/>
1065 </style:style>
1066 <style:style style:name="TLXO${rnd}ITALIC" style:family="text">
1067 <style:text-properties fo:font-style="italic" style:font-style-asian="italic" style:font-style-complex="italic"/>
1068 </style:style>
1069 <style:style style:name="TLXO${rnd}UNDERLINE" style:family="text">
1070 <style:text-properties style:text-underline-style="solid" style:text-underline-width="auto" style:text-underline-color="font-color"/>
1071 </style:style>
1072 <style:style style:name="TLXO${rnd}STRIKETHROUGH" style:family="text">
1073 <style:text-properties style:text-line-through-style="solid"/>
1074 </style:style>
1075 <style:style style:name="TLXO${rnd}SUPER" style:family="text">
1076 <style:text-properties style:text-position="super 58%"/>
1077 </style:style>
1078 <style:style style:name="TLXO${rnd}SUB" style:family="text">
1079 <style:text-properties style:text-position="sub 58%"/>
1080 </style:style>
1081 |;
1082
1083   $contents =~ s|</office:automatic-styles>|${new_styles}</office:automatic-styles>|;
1084   $contents =~ s|[\n\r]||gm;
1085
1086   my $new_contents = $self->parse_block($contents);
1087   if (!defined($new_contents)) {
1088     $main::lxdebug->leave_sub();
1089     return 0;
1090   }
1091
1092 #   $new_contents =~ s|>|>\n|g;
1093
1094   $zip->contents("content.xml", $new_contents);
1095
1096   my $styles = $zip->contents("styles.xml");
1097   if ($contents) {
1098     my $new_styles = $self->parse_block($styles);
1099     if (!defined($new_contents)) {
1100       $main::lxdebug->leave_sub();
1101       return 0;
1102     }
1103     $zip->contents("styles.xml", $new_styles);
1104   }
1105
1106   $zip->writeToFileNamed($form->{"tmpfile"}, 1);
1107
1108   my $res = 1;
1109   if ($form->{"format"} =~ /pdf/) {
1110     $res = $self->convert_to_pdf();
1111   }
1112
1113   $main::lxdebug->leave_sub();
1114   return $res;
1115 }
1116
1117 sub is_xvfb_running {
1118   $main::lxdebug->enter_sub();
1119
1120   my ($self) = @_;
1121
1122   local *IN;
1123   my $dfname = $self->{"userspath"} . "/xvfb_display";
1124   my $display;
1125
1126   $main::lxdebug->message(LXDebug::DEBUG2, "    Looking for $dfname\n");
1127   if ((-f $dfname) && open(IN, $dfname)) {
1128     my $pid = <IN>;
1129     chomp($pid);
1130     $display = <IN>;
1131     chomp($display);
1132     my $xauthority = <IN>;
1133     chomp($xauthority);
1134     close(IN);
1135
1136     $main::lxdebug->message(LXDebug::DEBUG2, "      found with $pid and $display\n");
1137
1138     if ((! -d "/proc/$pid") || !open(IN, "/proc/$pid/cmdline")) {
1139       $main::lxdebug->message(LXDebug::DEBUG2, "  no/wrong process #1\n");
1140       unlink($dfname, $xauthority);
1141       $main::lxdebug->leave_sub();
1142       return undef;
1143     }
1144     my $line = <IN>;
1145     close(IN);
1146     if ($line !~ /xvfb/i) {
1147       $main::lxdebug->message(LXDebug::DEBUG2, "      no/wrong process #2\n");
1148       unlink($dfname, $xauthority);
1149       $main::lxdebug->leave_sub();
1150       return undef;
1151     }
1152
1153     $ENV{"XAUTHORITY"} = $xauthority;
1154     $ENV{"DISPLAY"} = $display;
1155   } else {
1156     $main::lxdebug->message(LXDebug::DEBUG2, "      not found\n");
1157   }
1158
1159   $main::lxdebug->leave_sub();
1160
1161   return $display;
1162 }
1163
1164 sub spawn_xvfb {
1165   $main::lxdebug->enter_sub();
1166
1167   my ($self) = @_;
1168
1169   $main::lxdebug->message(LXDebug::DEBUG2, "spawn_xvfb()\n");
1170
1171   my $display = $self->is_xvfb_running();
1172
1173   if ($display) {
1174     $main::lxdebug->leave_sub();
1175     return $display;
1176   }
1177
1178   $display = 99;
1179   while ( -f "/tmp/.X${display}-lock") {
1180     $display++;
1181   }
1182   $display = ":${display}";
1183   $main::lxdebug->message(LXDebug::DEBUG2, "  display $display\n");
1184
1185   my $mcookie = `mcookie`;
1186   die("Installation error: mcookie not found.") if ($? != 0);
1187   chomp($mcookie);
1188
1189   $main::lxdebug->message(LXDebug::DEBUG2, "  mcookie $mcookie\n");
1190
1191   my $xauthority = "/tmp/.Xauthority-" . $$ . "-" . time() . "-" . int(rand(9999999));
1192   $ENV{"XAUTHORITY"} = $xauthority;
1193
1194   $main::lxdebug->message(LXDebug::DEBUG2, "  xauthority $xauthority\n");
1195
1196   system("xauth add \"${display}\" . \"${mcookie}\"");
1197   if ($? != 0) {
1198     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started (xauth: $!)";
1199     $main::lxdebug->leave_sub();
1200     return undef;
1201   }
1202
1203   $main::lxdebug->message(LXDebug::DEBUG2, "  about to fork()\n");
1204
1205   my $pid = fork();
1206   if (0 == $pid) {
1207     $main::lxdebug->message(LXDebug::DEBUG2, "  Child execing\n");
1208     exec($main::xvfb_bin, $display, "-screen", "0", "640x480x8", "-nolisten", "tcp");
1209   }
1210   sleep(3);
1211   $main::lxdebug->message(LXDebug::DEBUG2, "  parent dont sleeping\n");
1212
1213   local *OUT;
1214   my $dfname = $self->{"userspath"} . "/xvfb_display";
1215   if (!open(OUT, ">$dfname")) {
1216     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started ($dfname: $!)";
1217     unlink($xauthority);
1218     kill($pid);
1219     $main::lxdebug->leave_sub();
1220     return undef;
1221   }
1222   print(OUT "$pid\n$display\n$xauthority\n");
1223   close(OUT);
1224
1225   $main::lxdebug->message(LXDebug::DEBUG2, "  parent re-testing\n");
1226
1227   if (!$self->is_xvfb_running()) {
1228     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started.";
1229     unlink($xauthority, $dfname);
1230     kill($pid);
1231     $main::lxdebug->leave_sub();
1232     return undef;
1233   }
1234
1235   $main::lxdebug->message(LXDebug::DEBUG2, "  spawn OK\n");
1236
1237   $main::lxdebug->leave_sub();
1238
1239   return $display;
1240 }
1241
1242 sub is_openoffice_running {
1243   $main::lxdebug->enter_sub();
1244
1245   system("./scripts/oo-uno-test-conn.py $main::openofficeorg_daemon_port " .
1246          "> /dev/null 2> /dev/null");
1247   my $res = $? == 0;
1248   $main::lxdebug->message(LXDebug::DEBUG2, "  is_openoffice_running(): $?\n");
1249
1250   $main::lxdebug->leave_sub();
1251
1252   return $res;
1253 }
1254
1255 sub spawn_openoffice {
1256   $main::lxdebug->enter_sub();
1257
1258   my ($self) = @_;
1259
1260   $main::lxdebug->message(LXDebug::DEBUG2, "spawn_openoffice()\n");
1261
1262   my ($try, $spawned_oo, $res);
1263
1264   $res = 0;
1265   for ($try = 0; $try < 15; $try++) {
1266     if ($self->is_openoffice_running()) {
1267       $res = 1;
1268       last;
1269     }
1270
1271     if (!$spawned_oo) {
1272       my $pid = fork();
1273       if (0 == $pid) {
1274         $main::lxdebug->message(LXDebug::DEBUG2, "  Child daemonizing\n");
1275         chdir('/');
1276         open(STDIN, '/dev/null');
1277         open(STDOUT, '>/dev/null');
1278         my $new_pid = fork();
1279         exit if ($new_pid);
1280         my $ssres = setsid();
1281         $main::lxdebug->message(LXDebug::DEBUG2, "  Child execing\n");
1282         my @cmdline = ($main::openofficeorg_writer_bin,
1283                        "-minimized", "-norestore", "-nologo", "-nolockcheck",
1284                        "-headless",
1285                        "-accept=socket,host=localhost,port=" .
1286                        $main::openofficeorg_daemon_port . ";urp;");
1287         exec(@cmdline);
1288       }
1289
1290       $main::lxdebug->message(LXDebug::DEBUG2, "  Parent after fork\n");
1291       $spawned_oo = 1;
1292       sleep(3);
1293     }
1294
1295     sleep($try >= 5 ? 2 : 1);
1296   }
1297
1298   if (!$res) {
1299     $self->{"error"} = "Conversion from OpenDocument to PDF failed because " .
1300       "OpenOffice could not be started.";
1301   }
1302
1303   $main::lxdebug->leave_sub();
1304
1305   return $res;
1306 }
1307
1308 sub convert_to_pdf {
1309   $main::lxdebug->enter_sub();
1310
1311   my ($self) = @_;
1312
1313   my $form = $self->{"form"};
1314
1315   my $filename = $form->{"tmpfile"};
1316   $filename =~ s/.odt$//;
1317   if (substr($filename, 0, 1) ne "/") {
1318     $filename = getcwd() . "/${filename}";
1319   }
1320
1321   if (substr($self->{"userspath"}, 0, 1) eq "/") {
1322     $ENV{'HOME'} = $self->{"userspath"};
1323   } else {
1324     $ENV{'HOME'} = getcwd() . "/" . $self->{"userspath"};
1325   }
1326
1327   if (!$self->spawn_xvfb()) {
1328     $main::lxdebug->leave_sub();
1329     return 0;
1330   }
1331
1332   my @cmdline;
1333   if (!$main::openofficeorg_daemon) {
1334     @cmdline = ($main::openofficeorg_writer_bin,
1335                 "-minimized", "-norestore", "-nologo", "-nolockcheck",
1336                 "-headless",
1337                 "file:${filename}.odt",
1338                 "macro://" . (split('/', $filename))[-1] .
1339                 "/Standard.Conversion.ConvertSelfToPDF()");
1340   } else {
1341     if (!$self->spawn_openoffice()) {
1342       $main::lxdebug->leave_sub();
1343       return 0;
1344     }
1345
1346     @cmdline = ("./scripts/oo-uno-convert-pdf.py",
1347                 $main::openofficeorg_daemon_port,
1348                 "${filename}.odt");
1349   }
1350
1351   system(@cmdline);
1352
1353   my $res = $?;
1354   if (0 == $?) {
1355     $form->{"tmpfile"} =~ s/odt$/pdf/;
1356
1357     unlink($filename . ".odt");
1358
1359     $main::lxdebug->leave_sub();
1360     return 1;
1361
1362   }
1363
1364   unlink($filename . ".odt", $filename . ".pdf");
1365   $self->{"error"} = "Conversion from OpenDocument to PDF failed. " .
1366     "Exit code: $res";
1367
1368   $main::lxdebug->leave_sub();
1369   return 0;
1370 }
1371
1372 sub format_string {
1373   my ($self, $variable) = @_;
1374   my $form = $self->{"form"};
1375   my $iconv = $self->{"iconv"};
1376
1377   $variable = $main::locale->quote_special_chars('Template/OpenDocument', $variable);
1378
1379   # Allow some HTML markup to be converted into the output format's
1380   # corresponding markup code, e.g. bold or italic.
1381   my $rnd = $self->{"rnd"};
1382   my %markup_replace = ("b" => "BOLD", "i" => "ITALIC", "s" => "STRIKETHROUGH",
1383                         "u" => "UNDERLINE", "sup" => "SUPER", "sub" => "SUB");
1384
1385   foreach my $key (keys(%markup_replace)) {
1386     my $value = $markup_replace{$key};
1387     $variable =~ s|\&lt;${key}\&gt;|<text:span text:style-name=\"TLXO${rnd}${value}\">|gi; #"
1388     $variable =~ s|\&lt;/${key}\&gt;|</text:span>|gi;
1389   }
1390
1391   return $iconv->convert($variable);
1392 }
1393
1394 sub get_mime_type() {
1395   if ($self->{"form"}->{"format"} =~ /pdf/) {
1396     return "application/pdf";
1397   } else {
1398     return "application/vnd.oasis.opendocument.text";
1399   }
1400 }
1401
1402 sub uses_temp_file {
1403   return 1;
1404 }
1405
1406
1407 ##########################################################
1408 ####
1409 #### XMLTemplate
1410 ####
1411 ##########################################################
1412
1413 package XMLTemplate;
1414
1415 use vars qw(@ISA);
1416
1417 @ISA = qw(HTMLTemplate);
1418
1419 sub new {
1420   #evtl auskommentieren
1421   my $type = shift;
1422
1423   return $type->SUPER::new(@_);
1424 }
1425
1426 sub format_string {
1427   my ($self, $variable) = @_;
1428   my $form = $self->{"form"};
1429
1430   $variable = $main::locale->quote_special_chars('Template/XML', $variable);
1431
1432   # Allow no markup to be converted into the output format
1433   my @markup_replace = ('b', 'i', 's', 'u', 'sub', 'sup');
1434
1435   foreach my $key (@markup_replace) {
1436     $variable =~ s/\&lt;(\/?)${key}\&gt;//g;
1437   }
1438
1439   return $variable;
1440 }
1441
1442 sub get_mime_type() {
1443   my ($self) = @_;
1444
1445   if ($self->{"form"}->{"format"} =~ /elsterwinston/i) {
1446     return "application/xml ";
1447   } elsif ($self->{"form"}->{"format"} =~ /elstertaxbird/i) {
1448     return "application/x-taxbird";
1449   } else {
1450     return "text";
1451   }
1452 }
1453
1454 sub uses_temp_file {
1455   # tempfile needet for XML Output
1456   return 1;
1457 }
1458
1459 1;