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