Einführung RegEx für Vergleichsoperationen in <%if ...%>-Statements.
[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\s*(not)?\s+(.*?)$self->{tag_end_qm}|) {
340       if ($contents !~ m/^$self->{tag_start_qm}
341                          \s*
342                          (not|\!)?           # $1 -- Eventuelle Negierung
343                          \s*
344                          ([^\s]+)            # $2 -- Name der zu überprüfenden Variablen
345                          (                   # $3 -- Beginn des optionalen Vergleiches
346                            \s*
347                            ([!=])=           # $4 -- Art des Vergleiches speichern
348                            \s*
349                            (                 # $5 -- Gequoteter String oder Bareword
350                              "(.*)(?<!\\)"   # $6 -- Gequoteter String -- direkter Vergleich mit eq bzw. ne; Escapete Anführungs als Teil des Strings belassen
351                            |
352                              ([^\s]+)        # $7 -- 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 = $4;        # '=' oder '!' oder undef, wenn kein Vergleich erkannt
366       my $quoted   = $5;        # nur gültig, wenn quoted string angegeben (siehe unten); dann "value" aus <%if var == "value" %>
367       my $bareword = $7;        # undef, falls quoted string angegeben wurde; andernfalls "othervar" aus <%if var == othervar %>
368
369       $not = !$not if ($operator && $operator eq '!');
370
371       substr($contents, 0, length($&)) = "";
372
373       ($block, $contents) = $self->find_end($contents, 0, $var, $not);
374       if (!$block) {
375         $self->{"error"} = "Unclosed $self->{tag_start}if${not}$self->{tag_end}." unless ($self->{"error"});
376         $main::lxdebug->leave_sub();
377         return undef;
378       }
379
380       my $value = $self->_get_loop_variable($var, 0, @indices);
381       my $hit   = 0;
382
383       if ($operator) {
384         my $compare_to = $bareword ? $self->_get_loop_variable($bareword, 0, @indices) : $quoted;
385         $hit           = ($not && !($value eq $compare_to)) || (!$not && ($value eq $compare_to));
386
387       } else {
388         $hit           = ($not && ! $value)                 || (!$not &&  $value);
389       }
390
391       if ($hit) {
392         my $new_text = $self->parse_block($block, @indices);
393         if (!defined($new_text)) {
394           $main::lxdebug->leave_sub();
395           return undef;
396         }
397         $new_contents .= $new_text;
398       }
399     }
400   }
401
402   $main::lxdebug->leave_sub();
403
404   return $new_contents;
405 }
406
407 sub parse_first_line {
408   my $self = shift;
409   my $line = shift || "";
410
411   if ($line =~ m/([^\s]+)set-tag-style([^\s]+)/) {
412     if ($1 eq $2) {
413       $self->{error} = "The tag start and end markers must not be equal.";
414       return 0;
415     }
416
417     $self->set_tag_style($1, $2);
418   }
419
420   return 1;
421 }
422
423 sub _parse_config_option {
424   my $self = shift;
425   my $line = shift;
426
427   $line =~ s/^\s*//;
428   $line =~ s/\s*$//;
429
430   my ($key, $value) = split m/\s*=\s*/, $line, 2;
431
432   if ($key eq 'tag-style') {
433     $self->set_tag_style(split(m/\s+/, $value, 2));
434   }
435 }
436
437 sub _parse_config_lines {
438   my $self  = shift;
439   my $lines = shift;
440
441   my ($comment_start, $comment_end) = ("", "");
442
443   if (ref $self eq 'LaTeXTemplate') {
444     $comment_start = '\s*%';
445   } elsif (ref $self eq 'HTMLTemplate') {
446     $comment_start = '\s*<!--';
447     $comment_end   = '>\s*';
448   } else {
449     $comment_start = '\s*\#';
450   }
451
452   my $num_lines = scalar @{ $lines };
453   my $i         = 0;
454
455   while ($i < $num_lines) {
456     my $line = $lines->[$i];
457
458     if ($line !~ m/^${comment_start}\s*config\s*:(.*)${comment_end}$/i) {
459       $i++;
460       next;
461     }
462
463     $self->_parse_config_option($1);
464     splice @{ $lines }, $i, 1;
465     $num_lines--;
466   }
467 }
468
469 sub _force_mandatory_packages {
470   my $self  = shift;
471   my $lines = shift;
472
473   my (%used_packages, $document_start_line);
474
475   foreach my $i (0 .. scalar @{ $lines } - 1) {
476     if ($lines->[$i] =~ m/\\usepackage[^{]*{(.*?)}/) {
477       $used_packages{$1} = 1;
478
479     } elsif ($lines->[$i] =~ m/\\begin{document}/) {
480       $document_start_line = $i;
481       last;
482
483     }
484   }
485
486   $document_start_line = scalar @{ $lines } - 1 if (!defined $document_start_line);
487
488   if (!$used_packages{textcomp}) {
489     splice @{ $lines }, $document_start_line, 0, "\\usepackage{textcomp}\n";
490     $document_start_line++;
491   }
492 }
493
494 sub parse {
495   my $self = $_[0];
496   local *OUT = $_[1];
497   my $form = $self->{"form"};
498
499   if (!open(IN, "$form->{templates}/$form->{IN}")) {
500     $self->{"error"} = "$!";
501     return 0;
502   }
503   my @lines = <IN>;
504   close(IN);
505
506   $self->_parse_config_lines(\@lines);
507   $self->_force_mandatory_packages(\@lines) if (ref $self eq 'LaTeXTemplate');
508
509   my $contents = join("", @lines);
510
511   # detect pagebreak block and its parameters
512   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) {
513     $self->{"chars_per_line"} = $1;
514     $self->{"lines_on_first_page"} = $2;
515     $self->{"lines_on_second_page"} = $3;
516     $self->{"pagebreak_block"} = $4;
517
518     substr($contents, length($`), length($&)) = "";
519   }
520
521   $self->{"forced_pagebreaks"} = [];
522
523   my $new_contents = $self->parse_block($contents);
524   if (!defined($new_contents)) {
525     $main::lxdebug->leave_sub();
526     return 0;
527   }
528
529   print(OUT $new_contents);
530
531   if ($form->{"format"} =~ /postscript/i) {
532     return $self->convert_to_postscript();
533   } elsif ($form->{"format"} =~ /pdf/i) {
534     return $self->convert_to_pdf();
535   } else {
536     return 1;
537   }
538 }
539
540 sub convert_to_postscript {
541   my ($self) = @_;
542   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
543
544   # Convert the tex file to postscript
545
546   if (!chdir("$userspath")) {
547     $self->{"error"} = "chdir : $!";
548     $self->cleanup();
549     return 0;
550   }
551
552   $form->{tmpfile} =~ s/\Q$userspath\E\///g;
553
554   my $latex = $self->_get_latex_path();
555
556   for (my $run = 1; $run <= 2; $run++) {
557     system("${latex} --interaction=nonstopmode $form->{tmpfile} " .
558            "> $form->{tmpfile}.err");
559     if ($?) {
560       $self->{"error"} = $form->cleanup();
561       $self->cleanup();
562       return 0;
563     }
564   }
565
566   $form->{tmpfile} =~ s/tex$/dvi/;
567
568   system("dvips $form->{tmpfile} -o -q > /dev/null");
569   if ($?) {
570     $self->{"error"} = "dvips : $!";
571     $self->cleanup();
572     return 0;
573   }
574   $form->{tmpfile} =~ s/dvi$/ps/;
575
576   $self->cleanup();
577
578   return 1;
579 }
580
581 sub convert_to_pdf {
582   my ($self) = @_;
583   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
584
585   # Convert the tex file to PDF
586
587   if (!chdir("$userspath")) {
588     $self->{"error"} = "chdir : $!";
589     $self->cleanup();
590     return 0;
591   }
592
593   $form->{tmpfile} =~ s/\Q$userspath\E\///g;
594
595   my $latex = $self->_get_latex_path();
596
597   for (my $run = 1; $run <= 2; $run++) {
598     system("${latex} --interaction=nonstopmode $form->{tmpfile} " .
599            "> $form->{tmpfile}.err");
600     if ($?) {
601       $self->{"error"} = $form->cleanup();
602       $self->cleanup();
603       return 0;
604     }
605   }
606
607   $form->{tmpfile} =~ s/tex$/pdf/;
608
609   $self->cleanup();
610 }
611
612 sub _get_latex_path {
613   return $main::latex_bin || 'pdflatex';
614 }
615
616 sub get_mime_type() {
617   my ($self) = @_;
618
619   if ($self->{"form"}->{"format"} =~ /postscript/i) {
620     return "application/postscript";
621   } else {
622     return "application/pdf";
623   }
624 }
625
626 sub uses_temp_file {
627   return 1;
628 }
629
630
631 ####
632 #### HTMLTemplate
633 ####
634
635 package HTMLTemplate;
636
637 use vars qw(@ISA);
638
639 @ISA = qw(LaTeXTemplate);
640
641 sub new {
642   my $type = shift;
643
644   return $type->SUPER::new(@_);
645 }
646
647 sub format_string {
648   my ($self, $variable) = @_;
649   my $form = $self->{"form"};
650
651   $variable = $main::locale->quote_special_chars('Template/HTML', $variable);
652
653   # Allow some HTML markup to be converted into the output format's
654   # corresponding markup code, e.g. bold or italic.
655   my @markup_replace = ('b', 'i', 's', 'u', 'sub', 'sup');
656
657   foreach my $key (@markup_replace) {
658     $variable =~ s/\&lt;(\/?)${key}\&gt;/<$1${key}>/g;
659   }
660
661   return $variable;
662 }
663
664 sub get_mime_type() {
665   my ($self) = @_;
666
667   if ($self->{"form"}->{"format"} =~ /postscript/i) {
668     return "application/postscript";
669   } elsif ($self->{"form"}->{"format"} =~ /pdf/i) {
670     return "application/pdf";
671   } else {
672     return "text/html";
673   }
674 }
675
676 sub uses_temp_file {
677   my ($self) = @_;
678
679   if ($self->{"form"}->{"format"} =~ /postscript/i) {
680     return 1;
681   } elsif ($self->{"form"}->{"format"} =~ /pdf/i) {
682     return 1;
683   } else {
684     return 0;
685   }
686 }
687
688 sub convert_to_postscript {
689   my ($self) = @_;
690   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
691
692   # Convert the HTML file to postscript
693
694   if (!chdir("$userspath")) {
695     $self->{"error"} = "chdir : $!";
696     $self->cleanup();
697     return 0;
698   }
699
700   $form->{"tmpfile"} =~ s/\Q$userspath\E\///g;
701   my $psfile = $form->{"tmpfile"};
702   $psfile =~ s/.html/.ps/;
703   if ($psfile eq $form->{"tmpfile"}) {
704     $psfile .= ".ps";
705   }
706
707   system("html2ps -f html2ps-config < $form->{tmpfile} > $psfile");
708   if ($?) {
709     $self->{"error"} = $form->cleanup();
710     $self->cleanup();
711     return 0;
712   }
713
714   $form->{"tmpfile"} = $psfile;
715
716   $self->cleanup();
717
718   return 1;
719 }
720
721 sub convert_to_pdf {
722   my ($self) = @_;
723   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
724
725   # Convert the HTML file to PDF
726
727   if (!chdir("$userspath")) {
728     $self->{"error"} = "chdir : $!";
729     $self->cleanup();
730     return 0;
731   }
732
733   $form->{"tmpfile"} =~ s/\Q$userspath\E\///g;
734   my $pdffile = $form->{"tmpfile"};
735   $pdffile =~ s/.html/.pdf/;
736   if ($pdffile eq $form->{"tmpfile"}) {
737     $pdffile .= ".pdf";
738   }
739
740   system("html2ps -f html2ps-config < $form->{tmpfile} | ps2pdf - $pdffile");
741   if ($?) {
742     $self->{"error"} = $form->cleanup();
743     $self->cleanup();
744     return 0;
745   }
746
747   $form->{"tmpfile"} = $pdffile;
748
749   $self->cleanup();
750
751   return 1;
752 }
753
754
755 ####
756 #### PlainTextTemplate
757 ####
758
759 package PlainTextTemplate;
760
761 use vars qw(@ISA);
762
763 @ISA = qw(LaTeXTemplate);
764
765 sub new {
766   my $type = shift;
767
768   return $type->SUPER::new(@_);
769 }
770
771 sub format_string {
772   my ($self, $variable) = @_;
773
774   return $variable;
775 }
776
777 sub get_mime_type {
778   return "text/plain";
779 }
780
781 sub parse {
782 }
783
784 1;
785
786 ####
787 #### OpenDocumentTemplate
788 ####
789
790 package OpenDocumentTemplate;
791
792 use POSIX 'setsid';
793 use vars qw(@ISA);
794
795 use Cwd;
796 # use File::Copy;
797 # use File::Spec;
798 # use File::Temp qw(:mktemp);
799 use IO::File;
800
801 @ISA = qw(SimpleTemplate);
802
803 sub new {
804   my $type = shift;
805
806   $self = $type->SUPER::new(@_);
807
808   foreach my $module (qw(Archive::Zip Text::Iconv)) {
809     eval("use ${module};");
810     if ($@) {
811       $self->{"form"}->error("The Perl module '${module}' could not be " .
812                              "loaded. Support for OpenDocument templates " .
813                              "does not work without it. Please install your " .
814                              "distribution's package or get the module from " .
815                              "CPAN ( http://www.cpan.org ).");
816     }
817   }
818
819   $self->{"rnd"}   = int(rand(1000000));
820   $self->{"iconv"} = Text::Iconv->new($main::dbcharset, "UTF-8");
821
822   $self->set_tag_style('&lt;%', '%&gt;');
823
824   return $self;
825 }
826
827 sub parse_foreach {
828   my ($self, $var, $text, $start_tag, $end_tag, @indices) = @_;
829
830   my ($form, $new_contents) = ($self->{"form"}, "");
831
832   my $ary = $self->_get_loop_variable($var, 1, @indices);
833
834   for (my $i = 0; $i < scalar(@{$ary}); $i++) {
835     $form->{"__first__"} = $i == 0;
836     $form->{"__last__"} = ($i + 1) == scalar(@{$ary});
837     $form->{"__odd__"} = (($i + 1) % 2) == 1;
838     $form->{"__counter__"} = $i + 1;
839     my $new_text = $self->parse_block($text, (@indices, $i));
840     return undef unless (defined($new_text));
841     $new_contents .= $start_tag . $new_text . $end_tag;
842   }
843   map({ delete($form->{"__${_}__"}); } qw(first last odd counter));
844
845   return $new_contents;
846 }
847
848 sub find_end {
849   my ($self, $text, $pos, $var, $not) = @_;
850
851   my $depth = 1;
852   $pos = 0 unless ($pos);
853
854   while ($pos < length($text)) {
855     $pos++;
856
857     next if (substr($text, $pos - 1, 5) ne '&lt;%');
858
859     if ((substr($text, $pos + 4, 2) eq 'if') || (substr($text, $pos + 4, 3) eq 'for')) {
860       $depth++;
861
862     } elsif ((substr($text, $pos + 4, 4) eq 'else') && (1 == $depth)) {
863       if (!$var) {
864         $self->{"error"} = '<%else%> outside of <%if%> / <%ifnot%>.';
865         return undef;
866       }
867
868       my $block = substr($text, 0, $pos - 1);
869       substr($text, 0, $pos - 1) = "";
870       $text =~ s!^\&lt;\%[^\%]+\%\&gt;!!;
871       $text = '&lt;%if' . ($not ?  " " : "not ") . $var . '%&gt;' . $text;
872
873       return ($block, $text);
874
875     } elsif (substr($text, $pos + 4, 3) eq 'end') {
876       $depth--;
877       if ($depth == 0) {
878         my $block = substr($text, 0, $pos - 1);
879         substr($text, 0, $pos - 1) = "";
880         $text =~ s!^\&lt;\%[^\%]+\%\&gt;!!;
881
882         return ($block, $text);
883       }
884     }
885   }
886
887   return undef;
888 }
889
890 sub parse_block {
891   $main::lxdebug->enter_sub();
892
893   my ($self, $contents, @indices) = @_;
894
895   my $new_contents = "";
896
897   while ($contents ne "") {
898     if (substr($contents, 0, 1) eq "<") {
899       $contents =~ m|^<[^>]+>|;
900       my $tag = $&;
901       substr($contents, 0, length($&)) = "";
902
903       if ($tag =~ m|<table:table-row|) {
904         $contents =~ m|^(.*?)(</table:table-row[^>]*>)|;
905         my $table_row = $1;
906         my $end_tag = $2;
907         substr($contents, 0, length($1) + length($end_tag)) = "";
908
909         if ($table_row =~ m|\&lt;\%foreachrow\s+(.*?)\%\&gt;|) {
910           my $var = $1;
911
912           substr($table_row, length($`), length($&)) = "";
913
914           my ($t1, $t2) = $self->find_end($table_row, length($`));
915           if (!$t1) {
916             $self->{"error"} = "Unclosed <\%foreachrow\%>." unless ($self->{"error"});
917             $main::lxdebug->leave_sub();
918             return undef;
919           }
920
921           my $new_text = $self->parse_foreach($var, $t1 . $t2, $tag, $end_tag, @indices);
922           if (!defined($new_text)) {
923             $main::lxdebug->leave_sub();
924             return undef;
925           }
926           $new_contents .= $new_text;
927
928         } else {
929           my $new_text = $self->parse_block($table_row, @indices);
930           if (!defined($new_text)) {
931             $main::lxdebug->leave_sub();
932             return undef;
933           }
934           $new_contents .= $tag . $new_text . $end_tag;
935         }
936
937       } else {
938         $new_contents .= $tag;
939       }
940
941     } else {
942       $contents =~ /^[^<]+/;
943       my $text = $&;
944
945       my $pos_if = index($text, '&lt;%if');
946       my $pos_foreach = index($text, '&lt;%foreach');
947
948       if ((-1 == $pos_if) && (-1 == $pos_foreach)) {
949         substr($contents, 0, length($text)) = "";
950         $new_contents .= $self->substitute_vars($text, @indices);
951         next;
952       }
953
954       if ((-1 == $pos_if) || ((-1 != $pos_foreach) && ($pos_if > $pos_foreach))) {
955         $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_foreach), @indices);
956         substr($contents, 0, $pos_foreach) = "";
957
958         if ($contents !~ m|^\&lt;\%foreach (.*?)\%\&gt;|) {
959           $self->{"error"} = "Malformed <\%foreach\%>.";
960           $main::lxdebug->leave_sub();
961           return undef;
962         }
963
964         my $var = $1;
965
966         substr($contents, 0, length($&)) = "";
967
968         my $block;
969         ($block, $contents) = $self->find_end($contents);
970         if (!$block) {
971           $self->{"error"} = "Unclosed <\%foreach\%>." unless ($self->{"error"});
972           $main::lxdebug->leave_sub();
973           return undef;
974         }
975
976         my $new_text = $self->parse_foreach($var, $block, "", "", @indices);
977         if (!defined($new_text)) {
978           $main::lxdebug->leave_sub();
979           return undef;
980         }
981         $new_contents .= $new_text;
982
983       } else {
984         $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_if), @indices);
985         substr($contents, 0, $pos_if) = "";
986
987         if ($contents !~ m|^\&lt;\%if\s*(not)?\s+(.*?)\%\&gt;|) {
988           $self->{"error"} = "Malformed <\%if\%>.";
989           $main::lxdebug->leave_sub();
990           return undef;
991         }
992
993         my ($not, $var) = ($1, $2);
994
995         substr($contents, 0, length($&)) = "";
996
997         ($block, $contents) = $self->find_end($contents, 0, $var, $not);
998         if (!$block) {
999           $self->{"error"} = "Unclosed <\%if${not}\%>." unless ($self->{"error"});
1000           $main::lxdebug->leave_sub();
1001           return undef;
1002         }
1003
1004         my $value = $self->{"form"}->{$var};
1005         for (my $i = 0; $i < scalar(@indices); $i++) {
1006           last unless (ref($value) eq "ARRAY");
1007           $value = $value->[$indices[$i]];
1008         }
1009
1010         if (($not && !$value) || (!$not && $value)) {
1011           my $new_text = $self->parse_block($block, @indices);
1012           if (!defined($new_text)) {
1013             $main::lxdebug->leave_sub();
1014             return undef;
1015           }
1016           $new_contents .= $new_text;
1017         }
1018       }
1019     }
1020   }
1021
1022   $main::lxdebug->leave_sub();
1023
1024   return $new_contents;
1025 }
1026
1027 sub parse {
1028   $main::lxdebug->enter_sub();
1029
1030   my $self = $_[0];
1031   local *OUT = $_[1];
1032   my $form = $self->{"form"};
1033
1034   close(OUT);
1035
1036   my $file_name;
1037   if ($form->{"IN"} =~ m|^/|) {
1038     $file_name = $form->{"IN"};
1039   } else {
1040     $file_name = $form->{"templates"} . "/" . $form->{"IN"};
1041   }
1042
1043   my $zip = Archive::Zip->new();
1044   if (Archive::Zip::AZ_OK != $zip->read($file_name)) {
1045     $self->{"error"} = "File not found/is not a OpenDocument file.";
1046     $main::lxdebug->leave_sub();
1047     return 0;
1048   }
1049
1050   my $contents = $zip->contents("content.xml");
1051   if (!$contents) {
1052     $self->{"error"} = "File is not a OpenDocument file.";
1053     $main::lxdebug->leave_sub();
1054     return 0;
1055   }
1056
1057   my $rnd = $self->{"rnd"};
1058   my $new_styles = qq|<style:style style:name="TLXO${rnd}BOLD" style:family="text">
1059 <style:text-properties fo:font-weight="bold" style:font-weight-asian="bold" style:font-weight-complex="bold"/>
1060 </style:style>
1061 <style:style style:name="TLXO${rnd}ITALIC" style:family="text">
1062 <style:text-properties fo:font-style="italic" style:font-style-asian="italic" style:font-style-complex="italic"/>
1063 </style:style>
1064 <style:style style:name="TLXO${rnd}UNDERLINE" style:family="text">
1065 <style:text-properties style:text-underline-style="solid" style:text-underline-width="auto" style:text-underline-color="font-color"/>
1066 </style:style>
1067 <style:style style:name="TLXO${rnd}STRIKETHROUGH" style:family="text">
1068 <style:text-properties style:text-line-through-style="solid"/>
1069 </style:style>
1070 <style:style style:name="TLXO${rnd}SUPER" style:family="text">
1071 <style:text-properties style:text-position="super 58%"/>
1072 </style:style>
1073 <style:style style:name="TLXO${rnd}SUB" style:family="text">
1074 <style:text-properties style:text-position="sub 58%"/>
1075 </style:style>
1076 |;
1077
1078   $contents =~ s|</office:automatic-styles>|${new_styles}</office:automatic-styles>|;
1079   $contents =~ s|[\n\r]||gm;
1080
1081   my $new_contents = $self->parse_block($contents);
1082   if (!defined($new_contents)) {
1083     $main::lxdebug->leave_sub();
1084     return 0;
1085   }
1086
1087 #   $new_contents =~ s|>|>\n|g;
1088
1089   $zip->contents("content.xml", $new_contents);
1090
1091   my $styles = $zip->contents("styles.xml");
1092   if ($contents) {
1093     my $new_styles = $self->parse_block($styles);
1094     if (!defined($new_contents)) {
1095       $main::lxdebug->leave_sub();
1096       return 0;
1097     }
1098     $zip->contents("styles.xml", $new_styles);
1099   }
1100
1101   $zip->writeToFileNamed($form->{"tmpfile"}, 1);
1102
1103   my $res = 1;
1104   if ($form->{"format"} =~ /pdf/) {
1105     $res = $self->convert_to_pdf();
1106   }
1107
1108   $main::lxdebug->leave_sub();
1109   return $res;
1110 }
1111
1112 sub is_xvfb_running {
1113   $main::lxdebug->enter_sub();
1114
1115   my ($self) = @_;
1116
1117   local *IN;
1118   my $dfname = $self->{"userspath"} . "/xvfb_display";
1119   my $display;
1120
1121   $main::lxdebug->message(LXDebug::DEBUG2, "    Looking for $dfname\n");
1122   if ((-f $dfname) && open(IN, $dfname)) {
1123     my $pid = <IN>;
1124     chomp($pid);
1125     $display = <IN>;
1126     chomp($display);
1127     my $xauthority = <IN>;
1128     chomp($xauthority);
1129     close(IN);
1130
1131     $main::lxdebug->message(LXDebug::DEBUG2, "      found with $pid and $display\n");
1132
1133     if ((! -d "/proc/$pid") || !open(IN, "/proc/$pid/cmdline")) {
1134       $main::lxdebug->message(LXDebug::DEBUG2, "  no/wrong process #1\n");
1135       unlink($dfname, $xauthority);
1136       $main::lxdebug->leave_sub();
1137       return undef;
1138     }
1139     my $line = <IN>;
1140     close(IN);
1141     if ($line !~ /xvfb/i) {
1142       $main::lxdebug->message(LXDebug::DEBUG2, "      no/wrong process #2\n");
1143       unlink($dfname, $xauthority);
1144       $main::lxdebug->leave_sub();
1145       return undef;
1146     }
1147
1148     $ENV{"XAUTHORITY"} = $xauthority;
1149     $ENV{"DISPLAY"} = $display;
1150   } else {
1151     $main::lxdebug->message(LXDebug::DEBUG2, "      not found\n");
1152   }
1153
1154   $main::lxdebug->leave_sub();
1155
1156   return $display;
1157 }
1158
1159 sub spawn_xvfb {
1160   $main::lxdebug->enter_sub();
1161
1162   my ($self) = @_;
1163
1164   $main::lxdebug->message(LXDebug::DEBUG2, "spawn_xvfb()\n");
1165
1166   my $display = $self->is_xvfb_running();
1167
1168   if ($display) {
1169     $main::lxdebug->leave_sub();
1170     return $display;
1171   }
1172
1173   $display = 99;
1174   while ( -f "/tmp/.X${display}-lock") {
1175     $display++;
1176   }
1177   $display = ":${display}";
1178   $main::lxdebug->message(LXDebug::DEBUG2, "  display $display\n");
1179
1180   my $mcookie = `mcookie`;
1181   die("Installation error: mcookie not found.") if ($? != 0);
1182   chomp($mcookie);
1183
1184   $main::lxdebug->message(LXDebug::DEBUG2, "  mcookie $mcookie\n");
1185
1186   my $xauthority = "/tmp/.Xauthority-" . $$ . "-" . time() . "-" . int(rand(9999999));
1187   $ENV{"XAUTHORITY"} = $xauthority;
1188
1189   $main::lxdebug->message(LXDebug::DEBUG2, "  xauthority $xauthority\n");
1190
1191   system("xauth add \"${display}\" . \"${mcookie}\"");
1192   if ($? != 0) {
1193     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started (xauth: $!)";
1194     $main::lxdebug->leave_sub();
1195     return undef;
1196   }
1197
1198   $main::lxdebug->message(LXDebug::DEBUG2, "  about to fork()\n");
1199
1200   my $pid = fork();
1201   if (0 == $pid) {
1202     $main::lxdebug->message(LXDebug::DEBUG2, "  Child execing\n");
1203     exec($main::xvfb_bin, $display, "-screen", "0", "640x480x8", "-nolisten", "tcp");
1204   }
1205   sleep(3);
1206   $main::lxdebug->message(LXDebug::DEBUG2, "  parent dont sleeping\n");
1207
1208   local *OUT;
1209   my $dfname = $self->{"userspath"} . "/xvfb_display";
1210   if (!open(OUT, ">$dfname")) {
1211     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started ($dfname: $!)";
1212     unlink($xauthority);
1213     kill($pid);
1214     $main::lxdebug->leave_sub();
1215     return undef;
1216   }
1217   print(OUT "$pid\n$display\n$xauthority\n");
1218   close(OUT);
1219
1220   $main::lxdebug->message(LXDebug::DEBUG2, "  parent re-testing\n");
1221
1222   if (!$self->is_xvfb_running()) {
1223     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started.";
1224     unlink($xauthority, $dfname);
1225     kill($pid);
1226     $main::lxdebug->leave_sub();
1227     return undef;
1228   }
1229
1230   $main::lxdebug->message(LXDebug::DEBUG2, "  spawn OK\n");
1231
1232   $main::lxdebug->leave_sub();
1233
1234   return $display;
1235 }
1236
1237 sub is_openoffice_running {
1238   $main::lxdebug->enter_sub();
1239
1240   system("./scripts/oo-uno-test-conn.py $main::openofficeorg_daemon_port " .
1241          "> /dev/null 2> /dev/null");
1242   my $res = $? == 0;
1243   $main::lxdebug->message(LXDebug::DEBUG2, "  is_openoffice_running(): $?\n");
1244
1245   $main::lxdebug->leave_sub();
1246
1247   return $res;
1248 }
1249
1250 sub spawn_openoffice {
1251   $main::lxdebug->enter_sub();
1252
1253   my ($self) = @_;
1254
1255   $main::lxdebug->message(LXDebug::DEBUG2, "spawn_openoffice()\n");
1256
1257   my ($try, $spawned_oo, $res);
1258
1259   $res = 0;
1260   for ($try = 0; $try < 15; $try++) {
1261     if ($self->is_openoffice_running()) {
1262       $res = 1;
1263       last;
1264     }
1265
1266     if (!$spawned_oo) {
1267       my $pid = fork();
1268       if (0 == $pid) {
1269         $main::lxdebug->message(LXDebug::DEBUG2, "  Child daemonizing\n");
1270         chdir('/');
1271         open(STDIN, '/dev/null');
1272         open(STDOUT, '>/dev/null');
1273         my $new_pid = fork();
1274         exit if ($new_pid);
1275         my $ssres = setsid();
1276         $main::lxdebug->message(LXDebug::DEBUG2, "  Child execing\n");
1277         my @cmdline = ($main::openofficeorg_writer_bin,
1278                        "-minimized", "-norestore", "-nologo", "-nolockcheck",
1279                        "-headless",
1280                        "-accept=socket,host=localhost,port=" .
1281                        $main::openofficeorg_daemon_port . ";urp;");
1282         exec(@cmdline);
1283       }
1284
1285       $main::lxdebug->message(LXDebug::DEBUG2, "  Parent after fork\n");
1286       $spawned_oo = 1;
1287       sleep(3);
1288     }
1289
1290     sleep($try >= 5 ? 2 : 1);
1291   }
1292
1293   if (!$res) {
1294     $self->{"error"} = "Conversion from OpenDocument to PDF failed because " .
1295       "OpenOffice could not be started.";
1296   }
1297
1298   $main::lxdebug->leave_sub();
1299
1300   return $res;
1301 }
1302
1303 sub convert_to_pdf {
1304   $main::lxdebug->enter_sub();
1305
1306   my ($self) = @_;
1307
1308   my $form = $self->{"form"};
1309
1310   my $filename = $form->{"tmpfile"};
1311   $filename =~ s/.odt$//;
1312   if (substr($filename, 0, 1) ne "/") {
1313     $filename = getcwd() . "/${filename}";
1314   }
1315
1316   if (substr($self->{"userspath"}, 0, 1) eq "/") {
1317     $ENV{'HOME'} = $self->{"userspath"};
1318   } else {
1319     $ENV{'HOME'} = getcwd() . "/" . $self->{"userspath"};
1320   }
1321
1322   if (!$self->spawn_xvfb()) {
1323     $main::lxdebug->leave_sub();
1324     return 0;
1325   }
1326
1327   my @cmdline;
1328   if (!$main::openofficeorg_daemon) {
1329     @cmdline = ($main::openofficeorg_writer_bin,
1330                 "-minimized", "-norestore", "-nologo", "-nolockcheck",
1331                 "-headless",
1332                 "file:${filename}.odt",
1333                 "macro://" . (split('/', $filename))[-1] .
1334                 "/Standard.Conversion.ConvertSelfToPDF()");
1335   } else {
1336     if (!$self->spawn_openoffice()) {
1337       $main::lxdebug->leave_sub();
1338       return 0;
1339     }
1340
1341     @cmdline = ("./scripts/oo-uno-convert-pdf.py",
1342                 $main::openofficeorg_daemon_port,
1343                 "${filename}.odt");
1344   }
1345
1346   system(@cmdline);
1347
1348   my $res = $?;
1349   if (0 == $?) {
1350     $form->{"tmpfile"} =~ s/odt$/pdf/;
1351
1352     unlink($filename . ".odt");
1353
1354     $main::lxdebug->leave_sub();
1355     return 1;
1356
1357   }
1358
1359   unlink($filename . ".odt", $filename . ".pdf");
1360   $self->{"error"} = "Conversion from OpenDocument to PDF failed. " .
1361     "Exit code: $res";
1362
1363   $main::lxdebug->leave_sub();
1364   return 0;
1365 }
1366
1367 sub format_string {
1368   my ($self, $variable) = @_;
1369   my $form = $self->{"form"};
1370   my $iconv = $self->{"iconv"};
1371
1372   $variable = $main::locale->quote_special_chars('Template/OpenDocument', $variable);
1373
1374   # Allow some HTML markup to be converted into the output format's
1375   # corresponding markup code, e.g. bold or italic.
1376   my $rnd = $self->{"rnd"};
1377   my %markup_replace = ("b" => "BOLD", "i" => "ITALIC", "s" => "STRIKETHROUGH",
1378                         "u" => "UNDERLINE", "sup" => "SUPER", "sub" => "SUB");
1379
1380   foreach my $key (keys(%markup_replace)) {
1381     my $value = $markup_replace{$key};
1382     $variable =~ s|\&lt;${key}\&gt;|<text:span text:style-name=\"TLXO${rnd}${value}\">|gi; #"
1383     $variable =~ s|\&lt;/${key}\&gt;|</text:span>|gi;
1384   }
1385
1386   return $iconv->convert($variable);
1387 }
1388
1389 sub get_mime_type() {
1390   if ($self->{"form"}->{"format"} =~ /pdf/) {
1391     return "application/pdf";
1392   } else {
1393     return "application/vnd.oasis.opendocument.text";
1394   }
1395 }
1396
1397 sub uses_temp_file {
1398   return 1;
1399 }
1400
1401
1402 ##########################################################
1403 ####
1404 #### XMLTemplate
1405 ####
1406 ##########################################################
1407
1408 package XMLTemplate;
1409
1410 use vars qw(@ISA);
1411
1412 @ISA = qw(HTMLTemplate);
1413
1414 sub new {
1415   #evtl auskommentieren
1416   my $type = shift;
1417
1418   return $type->SUPER::new(@_);
1419 }
1420
1421 sub format_string {
1422   my ($self, $variable) = @_;
1423   my $form = $self->{"form"};
1424
1425   $variable = $main::locale->quote_special_chars('Template/XML', $variable);
1426
1427   # Allow no markup to be converted into the output format
1428   my @markup_replace = ('b', 'i', 's', 'u', 'sub', 'sup');
1429
1430   foreach my $key (@markup_replace) {
1431     $variable =~ s/\&lt;(\/?)${key}\&gt;//g;
1432   }
1433
1434   return $variable;
1435 }
1436
1437 sub get_mime_type() {
1438   my ($self) = @_;
1439
1440   if ($self->{"form"}->{"format"} =~ /elsterwinston/i) {
1441     return "application/xml ";
1442   } elsif ($self->{"form"}->{"format"} =~ /elstertaxbird/i) {
1443     return "application/x-taxbird";
1444   } else {
1445     return "text";
1446   }
1447 }
1448
1449 sub uses_temp_file {
1450   # tempfile needet for XML Output
1451   return 1;
1452 }
1453
1454 1;