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