Merge branch 'master' of vc.linet-services.de:public/lx-office-erp
[kivitendo-erp.git] / SL / Template / OpenDocument.pm
1 package SL::Template::OpenDocument;
2
3 use parent qw(SL::Template::Simple);
4
5 use Archive::Zip;
6 use Encode;
7 use POSIX 'setsid';
8
9 use SL::Iconv;
10
11 use Cwd;
12 # use File::Copy;
13 # use File::Spec;
14 # use File::Temp qw(:mktemp);
15 use IO::File;
16
17 use strict;
18
19 sub new {
20   my $type = shift;
21
22   my $self = $type->SUPER::new(@_);
23
24   $self->{"rnd"}   = int(rand(1000000));
25   $self->{"iconv"} = SL::Iconv->new($::lx_office_conf{system}->{dbcharset}, "UTF-8");
26
27   $self->set_tag_style('<%', '%>');
28   $self->{quot_re} = '"';
29
30   return $self;
31 }
32
33 sub parse_foreach {
34   my ($self, $var, $text, $start_tag, $end_tag, @indices) = @_;
35
36   my ($form, $new_contents) = ($self->{"form"}, "");
37
38   my $ary = $self->_get_loop_variable($var, 1, @indices);
39
40   for (my $i = 0; $i < scalar(@{$ary || []}); $i++) {
41     $form->{"__first__"} = $i == 0;
42     $form->{"__last__"} = ($i + 1) == scalar(@{$ary});
43     $form->{"__odd__"} = (($i + 1) % 2) == 1;
44     $form->{"__counter__"} = $i + 1;
45     my $new_text = $self->parse_block($text, (@indices, $i));
46     return undef unless (defined($new_text));
47     $new_contents .= $start_tag . $new_text . $end_tag;
48   }
49   map({ delete($form->{"__${_}__"}); } qw(first last odd counter));
50
51   return $new_contents;
52 }
53
54 sub find_end {
55   my ($self, $text, $pos, $var, $not) = @_;
56
57   my $depth = 1;
58   $pos = 0 unless ($pos);
59
60   while ($pos < length($text)) {
61     $pos++;
62
63     next if (substr($text, $pos - 1, 5) ne '&lt;%');
64
65     if ((substr($text, $pos + 4, 2) eq 'if') || (substr($text, $pos + 4, 3) eq 'for')) {
66       $depth++;
67
68     } elsif ((substr($text, $pos + 4, 4) eq 'else') && (1 == $depth)) {
69       if (!$var) {
70         $self->{"error"} = '<%else%> outside of <%if%> / <%ifnot%>.';
71         return undef;
72       }
73
74       my $block = substr($text, 0, $pos - 1);
75       substr($text, 0, $pos - 1) = "";
76       $text =~ s!^\&lt;\%[^\%]+\%\&gt;!!;
77       $text = '&lt;%if' . ($not ?  " " : "not ") . $var . '%&gt;' . $text;
78
79       return ($block, $text);
80
81     } elsif (substr($text, $pos + 4, 3) eq 'end') {
82       $depth--;
83       if ($depth == 0) {
84         my $block = substr($text, 0, $pos - 1);
85         substr($text, 0, $pos - 1) = "";
86         $text =~ s!^\&lt;\%[^\%]+\%\&gt;!!;
87
88         return ($block, $text);
89       }
90     }
91   }
92
93   return undef;
94 }
95
96 sub parse_block {
97   $main::lxdebug->enter_sub();
98
99   my ($self, $contents, @indices) = @_;
100
101   my $new_contents = "";
102
103   while ($contents ne "") {
104     if (substr($contents, 0, 1) eq "<") {
105       $contents =~ m|^<[^>]+>|;
106       my $tag = $&;
107       substr($contents, 0, length($&)) = "";
108
109       if ($tag =~ m|<table:table-row|) {
110         $contents =~ m|^(.*?)(</table:table-row[^>]*>)|;
111         my $table_row = $1;
112         my $end_tag = $2;
113
114         if ($table_row =~ m|\&lt;\%foreachrow\s+(.*?)\%\&gt;|) {
115           my $var = $1;
116
117           $contents =~ m|\&lt;\%foreachrow\s+.*?\%\&gt;|;
118           substr($contents, length($`), length($&)) = "";
119
120           ($table_row, $contents) = $self->find_end($contents, length($`));
121           if (!$table_row) {
122             $self->{"error"} = "Unclosed <\%foreachrow\%>." unless ($self->{"error"});
123             $main::lxdebug->leave_sub();
124             return undef;
125           }
126
127           $contents   =~ m|^(.*?)(</table:table-row[^>]*>)|;
128           $table_row .=  $1;
129           $end_tag    =  $2;
130
131           substr $contents, 0, length($&), '';
132
133           my $new_text = $self->parse_foreach($var, $table_row, $tag, $end_tag, @indices);
134           if (!defined($new_text)) {
135             $main::lxdebug->leave_sub();
136             return undef;
137           }
138           $new_contents .= $new_text;
139
140         } else {
141           substr($contents, 0, length($table_row) + length($end_tag)) = "";
142           my $new_text = $self->parse_block($table_row, @indices);
143           if (!defined($new_text)) {
144             $main::lxdebug->leave_sub();
145             return undef;
146           }
147           $new_contents .= $tag . $new_text . $end_tag;
148         }
149
150       } else {
151         $new_contents .= $tag;
152       }
153
154     } else {
155       $contents =~ /^[^<]+/;
156       my $text = $&;
157
158       my $pos_if = index($text, '&lt;%if');
159       my $pos_foreach = index($text, '&lt;%foreach');
160
161       if ((-1 == $pos_if) && (-1 == $pos_foreach)) {
162         substr($contents, 0, length($text)) = "";
163         $new_contents .= $self->substitute_vars($text, @indices);
164         next;
165       }
166
167       if ((-1 == $pos_if) || ((-1 != $pos_foreach) && ($pos_if > $pos_foreach))) {
168         $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_foreach), @indices);
169         substr($contents, 0, $pos_foreach) = "";
170
171         if ($contents !~ m|^\&lt;\%foreach (.*?)\%\&gt;|) {
172           $self->{"error"} = "Malformed <\%foreach\%>.";
173           $main::lxdebug->leave_sub();
174           return undef;
175         }
176
177         my $var = $1;
178
179         substr($contents, 0, length($&)) = "";
180
181         my $block;
182         ($block, $contents) = $self->find_end($contents);
183         if (!$block) {
184           $self->{"error"} = "Unclosed <\%foreach\%>." unless ($self->{"error"});
185           $main::lxdebug->leave_sub();
186           return undef;
187         }
188
189         my $new_text = $self->parse_foreach($var, $block, "", "", @indices);
190         if (!defined($new_text)) {
191           $main::lxdebug->leave_sub();
192           return undef;
193         }
194         $new_contents .= $new_text;
195
196       } else {
197         if (!$self->_parse_block_if(\$contents, \$new_contents, $pos_if, @indices)) {
198           $main::lxdebug->leave_sub();
199           return undef;
200         }
201       }
202     }
203   }
204
205   $main::lxdebug->leave_sub();
206
207   return $new_contents;
208 }
209
210 sub parse {
211   $main::lxdebug->enter_sub();
212   my $self = $_[0];
213   local *OUT = $_[1];
214   my $form = $self->{"form"};
215
216   close(OUT);
217
218   my $file_name;
219   if ($form->{"IN"} =~ m|^/|) {
220     $file_name = $form->{"IN"};
221   } else {
222     $file_name = $form->{"templates"} . "/" . $form->{"IN"};
223   }
224
225   my $zip = Archive::Zip->new();
226   if (Archive::Zip->AZ_OK != $zip->read($file_name)) {
227     $self->{"error"} = "File not found/is not a OpenDocument file.";
228     $main::lxdebug->leave_sub();
229     return 0;
230   }
231
232   my $contents = Encode::decode('utf-8-strict', $zip->contents("content.xml"));
233   if (!$contents) {
234     $self->{"error"} = "File is not a OpenDocument file.";
235     $main::lxdebug->leave_sub();
236     return 0;
237   }
238
239   my $rnd = $self->{"rnd"};
240   my $new_styles = qq|<style:style style:name="TLXO${rnd}BOLD" style:family="text">
241 <style:text-properties fo:font-weight="bold" style:font-weight-asian="bold" style:font-weight-complex="bold"/>
242 </style:style>
243 <style:style style:name="TLXO${rnd}ITALIC" style:family="text">
244 <style:text-properties fo:font-style="italic" style:font-style-asian="italic" style:font-style-complex="italic"/>
245 </style:style>
246 <style:style style:name="TLXO${rnd}UNDERLINE" style:family="text">
247 <style:text-properties style:text-underline-style="solid" style:text-underline-width="auto" style:text-underline-color="font-color"/>
248 </style:style>
249 <style:style style:name="TLXO${rnd}STRIKETHROUGH" style:family="text">
250 <style:text-properties style:text-line-through-style="solid"/>
251 </style:style>
252 <style:style style:name="TLXO${rnd}SUPER" style:family="text">
253 <style:text-properties style:text-position="super 58%"/>
254 </style:style>
255 <style:style style:name="TLXO${rnd}SUB" style:family="text">
256 <style:text-properties style:text-position="sub 58%"/>
257 </style:style>
258 |;
259
260   $contents =~ s|</office:automatic-styles>|${new_styles}</office:automatic-styles>|;
261   $contents =~ s|[\n\r]||gm;
262
263   my $new_contents = $self->parse_block($contents);
264   if (!defined($new_contents)) {
265     $main::lxdebug->leave_sub();
266     return 0;
267   }
268
269 #   $new_contents =~ s|>|>\n|g;
270
271   $zip->contents("content.xml", Encode::encode('utf-8-strict', $new_contents));
272
273   my $styles = $zip->contents("styles.xml");
274   if ($contents) {
275     my $new_styles = $self->parse_block($styles);
276     if (!defined($new_contents)) {
277       $main::lxdebug->leave_sub();
278       return 0;
279     }
280     $zip->contents("styles.xml", $new_styles);
281   }
282
283   $zip->writeToFileNamed($form->{"tmpfile"}, 1);
284
285   my $res = 1;
286   if ($form->{"format"} =~ /pdf/) {
287     $res = $self->convert_to_pdf();
288   }
289
290   $main::lxdebug->leave_sub();
291   return $res;
292 }
293
294 sub is_xvfb_running {
295   $main::lxdebug->enter_sub();
296
297   my ($self) = @_;
298
299   local *IN;
300   my $dfname = $self->{"userspath"} . "/xvfb_display";
301   my $display;
302
303   $main::lxdebug->message(LXDebug->DEBUG2(), "    Looking for $dfname\n");
304   if ((-f $dfname) && open(IN, $dfname)) {
305     my $pid = <IN>;
306     chomp($pid);
307     $display = <IN>;
308     chomp($display);
309     my $xauthority = <IN>;
310     chomp($xauthority);
311     close(IN);
312
313     $main::lxdebug->message(LXDebug->DEBUG2(), "      found with $pid and $display\n");
314
315     if ((! -d "/proc/$pid") || !open(IN, "/proc/$pid/cmdline")) {
316       $main::lxdebug->message(LXDebug->DEBUG2(), "  no/wrong process #1\n");
317       unlink($dfname, $xauthority);
318       $main::lxdebug->leave_sub();
319       return undef;
320     }
321     my $line = <IN>;
322     close(IN);
323     if ($line !~ /xvfb/i) {
324       $main::lxdebug->message(LXDebug->DEBUG2(), "      no/wrong process #2\n");
325       unlink($dfname, $xauthority);
326       $main::lxdebug->leave_sub();
327       return undef;
328     }
329
330     $ENV{"XAUTHORITY"} = $xauthority;
331     $ENV{"DISPLAY"} = $display;
332   } else {
333     $main::lxdebug->message(LXDebug->DEBUG2(), "      not found\n");
334   }
335
336   $main::lxdebug->leave_sub();
337
338   return $display;
339 }
340
341 sub spawn_xvfb {
342   $main::lxdebug->enter_sub();
343
344   my ($self) = @_;
345
346   $main::lxdebug->message(LXDebug->DEBUG2, "spawn_xvfb()\n");
347
348   my $display = $self->is_xvfb_running();
349
350   if ($display) {
351     $main::lxdebug->leave_sub();
352     return $display;
353   }
354
355   $display = 99;
356   while ( -f "/tmp/.X${display}-lock") {
357     $display++;
358   }
359   $display = ":${display}";
360   $main::lxdebug->message(LXDebug->DEBUG2(), "  display $display\n");
361
362   my $mcookie = `mcookie`;
363   die("Installation error: mcookie not found.") if ($? != 0);
364   chomp($mcookie);
365
366   $main::lxdebug->message(LXDebug->DEBUG2(), "  mcookie $mcookie\n");
367
368   my $xauthority = "/tmp/.Xauthority-" . $$ . "-" . time() . "-" . int(rand(9999999));
369   $ENV{"XAUTHORITY"} = $xauthority;
370
371   $main::lxdebug->message(LXDebug->DEBUG2(), "  xauthority $xauthority\n");
372
373   system("xauth add \"${display}\" . \"${mcookie}\"");
374   if ($? != 0) {
375     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started (xauth: $!)";
376     $main::lxdebug->leave_sub();
377     return undef;
378   }
379
380   $main::lxdebug->message(LXDebug->DEBUG2(), "  about to fork()\n");
381
382   my $pid = fork();
383   if (0 == $pid) {
384     $main::lxdebug->message(LXDebug->DEBUG2(), "  Child execing\n");
385     exec($::lx_office_conf{applications}->{xvfb}, $display, "-screen", "0", "640x480x8", "-nolisten", "tcp");
386   }
387   sleep(3);
388   $main::lxdebug->message(LXDebug->DEBUG2(), "  parent dont sleeping\n");
389
390   local *OUT;
391   my $dfname = $self->{"userspath"} . "/xvfb_display";
392   if (!open(OUT, ">", $dfname)) {
393     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started ($dfname: $!)";
394     unlink($xauthority);
395     kill($pid);
396     $main::lxdebug->leave_sub();
397     return undef;
398   }
399   print(OUT "$pid\n$display\n$xauthority\n");
400   close(OUT);
401
402   $main::lxdebug->message(LXDebug->DEBUG2(), "  parent re-testing\n");
403
404   if (!$self->is_xvfb_running()) {
405     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started.";
406     unlink($xauthority, $dfname);
407     kill($pid);
408     $main::lxdebug->leave_sub();
409     return undef;
410   }
411
412   $main::lxdebug->message(LXDebug->DEBUG2(), "  spawn OK\n");
413
414   $main::lxdebug->leave_sub();
415
416   return $display;
417 }
418
419 sub is_openoffice_running {
420   $main::lxdebug->enter_sub();
421
422   my $cmd    = "./scripts/oo-uno-test-conn.py " . $::lx_office_conf{print_templates}->{openofficeorg_daemon_port} . " 2> /dev/null";
423   my $output = `$cmd`;
424   chomp $output;
425
426   my $res = ($? == 0) || $output;
427   $main::lxdebug->message(LXDebug->DEBUG2(), "  is_openoffice_running(): res $res\n");
428
429   $main::lxdebug->leave_sub();
430
431   return $res;
432 }
433
434 sub spawn_openoffice {
435   $main::lxdebug->enter_sub();
436
437   my ($self) = @_;
438
439   $main::lxdebug->message(LXDebug->DEBUG2(), "spawn_openoffice()\n");
440
441   my ($try, $spawned_oo, $res);
442
443   $res = 0;
444   for ($try = 0; $try < 15; $try++) {
445     if ($self->is_openoffice_running()) {
446       $res = 1;
447       last;
448     }
449
450     if (!$spawned_oo) {
451       my $pid = fork();
452       if (0 == $pid) {
453         $main::lxdebug->message(LXDebug->DEBUG2(), "  Child daemonizing\n");
454         chdir('/');
455         open(STDIN, '/dev/null');
456         open(STDOUT, '>/dev/null');
457         my $new_pid = fork();
458         exit if ($new_pid);
459         my $ssres = setsid();
460         $main::lxdebug->message(LXDebug->DEBUG2(), "  Child execing\n");
461         my @cmdline = ($::lx_office_conf{applications}->{openofficeorg_writer},
462                        "-minimized", "-norestore", "-nologo", "-nolockcheck",
463                        "-headless",
464                        "-accept=socket,host=localhost,port=" .
465                        $::lx_office_conf{print_templates}->{openofficeorg_daemon_port} . ";urp;");
466         exec(@cmdline);
467       }
468
469       $main::lxdebug->message(LXDebug->DEBUG2(), "  Parent after fork\n");
470       $spawned_oo = 1;
471       sleep(3);
472     }
473
474     sleep($try >= 5 ? 2 : 1);
475   }
476
477   if (!$res) {
478     $self->{"error"} = "Conversion from OpenDocument to PDF failed because " .
479       "OpenOffice could not be started.";
480   }
481
482   $main::lxdebug->leave_sub();
483
484   return $res;
485 }
486
487 sub convert_to_pdf {
488   $main::lxdebug->enter_sub();
489
490   my ($self) = @_;
491
492   my $form = $self->{"form"};
493
494   my $filename = $form->{"tmpfile"};
495   $filename =~ s/.odt$//;
496   if (substr($filename, 0, 1) ne "/") {
497     $filename = getcwd() . "/${filename}";
498   }
499
500   if (substr($self->{"userspath"}, 0, 1) eq "/") {
501     $ENV{'HOME'} = $self->{"userspath"};
502   } else {
503     $ENV{'HOME'} = getcwd() . "/" . $self->{"userspath"};
504   }
505
506   if (!$self->spawn_xvfb()) {
507     $main::lxdebug->leave_sub();
508     return 0;
509   }
510
511   my @cmdline;
512   if (!$::lx_office_conf{print_templates}->{openofficeorg_daemon}) {
513     @cmdline = ($::lx_office_conf{applications}->{openofficeorg_writer},
514                 "-minimized", "-norestore", "-nologo", "-nolockcheck",
515                 "-headless",
516                 "file:${filename}.odt",
517                 "macro://" . (split('/', $filename))[-1] .
518                 "/Standard.Conversion.ConvertSelfToPDF()");
519   } else {
520     if (!$self->spawn_openoffice()) {
521       $main::lxdebug->leave_sub();
522       return 0;
523     }
524
525     @cmdline = ("./scripts/oo-uno-convert-pdf.py",
526                 $::lx_office_conf{print_templates}->{openofficeorg_daemon_port},
527                 "${filename}.odt");
528   }
529
530   system(@cmdline);
531
532   my $res = $?;
533   if ((0 == $?) || (-f "${filename}.pdf" && -s "${filename}.pdf")) {
534     $form->{"tmpfile"} =~ s/odt$/pdf/;
535
536     unlink($filename . ".odt");
537
538     $main::lxdebug->leave_sub();
539     return 1;
540
541   }
542
543   unlink($filename . ".odt", $filename . ".pdf");
544   $self->{"error"} = "Conversion from OpenDocument to PDF failed. " .
545     "Exit code: $res";
546
547   $main::lxdebug->leave_sub();
548   return 0;
549 }
550
551 sub format_string {
552   my ($self, $variable) = @_;
553   my $form = $self->{"form"};
554   my $iconv = $self->{"iconv"};
555
556   $variable = $main::locale->quote_special_chars('Template/OpenDocument', $variable);
557
558   # Allow some HTML markup to be converted into the output format's
559   # corresponding markup code, e.g. bold or italic.
560   my $rnd = $self->{"rnd"};
561   my %markup_replace = ("b" => "BOLD", "i" => "ITALIC", "s" => "STRIKETHROUGH",
562                         "u" => "UNDERLINE", "sup" => "SUPER", "sub" => "SUB");
563
564   foreach my $key (keys(%markup_replace)) {
565     my $value = $markup_replace{$key};
566     $variable =~ s|\&lt;${key}\&gt;|<text:span text:style-name=\"TLXO${rnd}${value}\">|gi; #"
567     $variable =~ s|\&lt;/${key}\&gt;|</text:span>|gi;
568   }
569
570   return $iconv->convert($variable);
571 }
572
573 sub get_mime_type() {
574   my ($self) = @_;
575
576   if ($self->{"form"}->{"format"} =~ /pdf/) {
577     return "application/pdf";
578   } else {
579     return "application/vnd.oasis.opendocument.text";
580   }
581 }
582
583 sub uses_temp_file {
584   return 1;
585 }
586
587 1;