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