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