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 {
 404   my $self = $_[0];
 405   local *OUT = $_[1];
 406   my $form = $self->{"form"};
 407
 408   if (!open(IN, "$form->{templates}/$form->{IN}")) {
 409     $self->{"error"} = "$!";
 410     return 0;
 411   }
 412   my @lines = <IN>;
 413   close(IN);
 414
 415   return 0 if (!$self->parse_first_line($lines[0]));
 416
 417   my $contents = join("", @lines);
 418
 419   # detect pagebreak block and its parameters
 420   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) {
 421     $self->{"chars_per_line"} = $1;
 422     $self->{"lines_on_first_page"} = $2;
 423     $self->{"lines_on_second_page"} = $3;
 424     $self->{"pagebreak_block"} = $4;
 425
 426     substr($contents, length($`), length($&)) = "";
 427   }
 428
 429   $self->{"forced_pagebreaks"} = [];
 430
 431   my $new_contents = $self->parse_block($contents);
 432   if (!defined($new_contents)) {
 433     $main::lxdebug->leave_sub();
 434     return 0;
 435   }
 436
 437   print(OUT $new_contents);
 438
 439   if ($form->{"format"} =~ /postscript/i) {
 440     return $self->convert_to_postscript();
 441   } elsif ($form->{"format"} =~ /pdf/i) {
 442     return $self->convert_to_pdf();
 443   } else {
 444     return 1;
 445   }
 446 }
 447
 448 sub convert_to_postscript {
 449   my ($self) = @_;
 450   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
 451
 452   # Convert the tex file to postscript
 453
 454   if (!chdir("$userspath")) {
 455     $self->{"error"} = "chdir : $!";
 456     $self->cleanup();
 457     return 0;
 458   }
 459
 460   $form->{tmpfile} =~ s/$userspath\///g;
 461
 462   for (my $run = 1; $run <= 2; $run++) {
 463     system("latex --interaction=nonstopmode $form->{tmpfile} " .
 464            "> $form->{tmpfile}.err");
 465     if ($?) {
 466       $self->{"error"} = $form->cleanup();
 467       $self->cleanup();
 468       return 0;
 469     }
 470   }
 471
 472   $form->{tmpfile} =~ s/tex$/dvi/;
 473
 474   system("dvips $form->{tmpfile} -o -q > /dev/null");
 475   if ($?) {
 476     $self->{"error"} = "dvips : $!";
 477     $self->cleanup();
 478     return 0;
 479   }
 480   $form->{tmpfile} =~ s/dvi$/ps/;
 481
 482   $self->cleanup();
 483
 484   return 1;
 485 }
 486
 487 sub convert_to_pdf {
 488   my ($self) = @_;
 489   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
 490
 491   # Convert the tex file to PDF
 492
 493   if (!chdir("$userspath")) {
 494     $self->{"error"} = "chdir : $!";
 495     $self->cleanup();
 496     return 0;
 497   }
 498
 499   $form->{tmpfile} =~ s/$userspath\///g;
 500
 501   for (my $run = 1; $run <= 2; $run++) {
 502     system("pdflatex --interaction=nonstopmode $form->{tmpfile} " .
 503            "> $form->{tmpfile}.err");
 504     if ($?) {
 505       $self->{"error"} = $form->cleanup();
 506       $self->cleanup();
 507       return 0;
 508     }
 509   }
 510
 511   $form->{tmpfile} =~ s/tex$/pdf/;
 512
 513   $self->cleanup();
 514 }
 515
 516 sub get_mime_type() {
 517   my ($self) = @_;
 518
 519   if ($self->{"form"}->{"format"} =~ /postscript/i) {
 520     return "application/postscript";
 521   } else {
 522     return "application/pdf";
 523   }
 524 }
 525
 526 sub uses_temp_file {
 527   return 1;
 528 }
 529
 530
 531 ####
 532 #### HTMLTemplate
 533 ####
 534
 535 package HTMLTemplate;
 536
 537 use vars qw(@ISA);
 538
 539 @ISA = qw(LaTeXTemplate);
 540
 541 sub new {
 542   my $type = shift;
 543
 544   return $type->SUPER::new(@_);
 545 }
 546
 547 sub format_string {
 548   my ($self, $variable) = @_;
 549   my $form = $self->{"form"};
 550
 551   my %replace =
 552     ('order' => ['<', '>', quotemeta("\n")],
 553      '<'             => '&lt;',
 554      '>'             => '&gt;',
 555      quotemeta("\n") => '<br>',
 556      );
 557
 558   map({ $variable =~ s/$_/$replace{$_}/g; } @{ $replace{"order"} });
 559
 560   # Allow some HTML markup to be converted into the output format's
 561   # corresponding markup code, e.g. bold or italic.
 562   my @markup_replace = ('b', 'i', 's', 'u', 'sub', 'sup');
 563
 564   foreach my $key (@markup_replace) {
 565     $variable =~ s/\&lt;(\/?)${key}\&gt;/<$1${key}>/g;
 566   }
 567
 568   return $variable;
 569 }
 570
 571 sub get_mime_type() {
 572   my ($self) = @_;
 573
 574   if ($self->{"form"}->{"format"} =~ /postscript/i) {
 575     return "application/postscript";
 576   } elsif ($self->{"form"}->{"format"} =~ /pdf/i) {
 577     return "application/pdf";
 578   } else {
 579     return "text/html";
 580   }
 581 }
 582
 583 sub uses_temp_file {
 584   my ($self) = @_;
 585
 586   if ($self->{"form"}->{"format"} =~ /postscript/i) {
 587     return 1;
 588   } elsif ($self->{"form"}->{"format"} =~ /pdf/i) {
 589     return 1;
 590   } else {
 591     return 0;
 592   }
 593 }
 594
 595 sub convert_to_postscript {
 596   my ($self) = @_;
 597   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
 598
 599   # Convert the HTML file to postscript
 600
 601   if (!chdir("$userspath")) {
 602     $self->{"error"} = "chdir : $!";
 603     $self->cleanup();
 604     return 0;
 605   }
 606
 607   $form->{"tmpfile"} =~ s/$userspath\///g;
 608   my $psfile = $form->{"tmpfile"};
 609   $psfile =~ s/.html/.ps/;
 610   if ($psfile eq $form->{"tmpfile"}) {
 611     $psfile .= ".ps";
 612   }
 613
 614   system("html2ps -f html2ps-config < $form->{tmpfile} > $psfile");
 615   if ($?) {
 616     $self->{"error"} = $form->cleanup();
 617     $self->cleanup();
 618     return 0;
 619   }
 620
 621   $form->{"tmpfile"} = $psfile;
 622
 623   $self->cleanup();
 624
 625   return 1;
 626 }
 627
 628 sub convert_to_pdf {
 629   my ($self) = @_;
 630   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
 631
 632   # Convert the HTML file to PDF
 633
 634   if (!chdir("$userspath")) {
 635     $self->{"error"} = "chdir : $!";
 636     $self->cleanup();
 637     return 0;
 638   }
 639
 640   $form->{"tmpfile"} =~ s/$userspath\///g;
 641   my $pdffile = $form->{"tmpfile"};
 642   $pdffile =~ s/.html/.pdf/;
 643   if ($pdffile eq $form->{"tmpfile"}) {
 644     $pdffile .= ".pdf";
 645   }
 646
 647   system("html2ps -f html2ps-config < $form->{tmpfile} | ps2pdf - $pdffile");
 648   if ($?) {
 649     $self->{"error"} = $form->cleanup();
 650     $self->cleanup();
 651     return 0;
 652   }
 653
 654   $form->{"tmpfile"} = $pdffile;
 655
 656   $self->cleanup();
 657
 658   return 1;
 659 }
 660
 661
 662 ####
 663 #### PlainTextTemplate
 664 ####
 665
 666 package PlainTextTemplate;
 667
 668 use vars qw(@ISA);
 669
 670 @ISA = qw(LaTeXTemplate);
 671
 672 sub new {
 673   my $type = shift;
 674
 675   return $type->SUPER::new(@_);
 676 }
 677
 678 sub format_string {
 679   my ($self, $variable) = @_;
 680
 681   return $variable;
 682 }
 683
 684 sub get_mime_type {
 685   return "text/plain";
 686 }
 687
 688 sub parse {
 689 }
 690
 691 1;
 692
 693 ####
 694 #### OpenDocumentTemplate
 695 ####
 696
 697 package OpenDocumentTemplate;
 698
 699 use POSIX 'setsid';
 700 use vars qw(@ISA);
 701
 702 use Cwd;
 703 # use File::Copy;
 704 # use File::Spec;
 705 # use File::Temp qw(:mktemp);
 706 use IO::File;
 707
 708 @ISA = qw(SimpleTemplate);
 709
 710 sub new {
 711   my $type = shift;
 712
 713   $self = $type->SUPER::new(@_);
 714
 715   foreach my $module (qw(Archive::Zip Text::Iconv)) {
 716     eval("use ${module};");
 717     if ($@) {
 718       $self->{"form"}->error("The Perl module '${module}' could not be " .
 719                              "loaded. Support for OpenDocument templates " .
 720                              "does not work without it. Please install your " .
 721                              "distribution's package or get the module from " .
 722                              "CPAN ( http://www.cpan.org ).");
 723     }
 724   }
 725
 726   $self->{"rnd"} = int(rand(1000000));
 727   $self->{"iconv"} = Text::Iconv->new($main::dbcharset, "UTF-8");
 728
 729   return $self;
 730 }
 731
 732 sub substitute_vars {
 733   my ($self, $text, @indices) = @_;
 734
 735   my $form = $self->{"form"};
 736
 737   while ($text =~ /\&lt;\%(.*?)\%\&gt;/) {
 738     my $value = $form->{$1};
 739
 740     for (my $i = 0; $i < scalar(@indices); $i++) {
 741       last unless (ref($value) eq "ARRAY");
 742       $value = $value->[$indices[$i]];
 743     }
 744     substr($text, $-[0], $+[0] - $-[0]) = $self->format_string($value);
 745   }
 746
 747   return $text;
 748 }
 749
 750 sub parse_foreach {
 751   my ($self, $var, $text, $start_tag, $end_tag, @indices) = @_;
 752
 753   my ($form, $new_contents) = ($self->{"form"}, "");
 754
 755   my $ary = $form->{$var};
 756   for (my $i = 0; $i < scalar(@indices); $i++) {
 757     last unless (ref($ary) eq "ARRAY");
 758     $ary = $ary->[$indices[$i]];
 759   }
 760
 761   for (my $i = 0; $i < scalar(@{$ary}); $i++) {
 762     $form->{"__first__"} = $i == 0;
 763     $form->{"__last__"} = ($i + 1) == scalar(@{$ary});
 764     $form->{"__odd__"} = (($i + 1) % 2) == 1;
 765     $form->{"__counter__"} = $i + 1;
 766     my $new_text = $self->parse_block($text, (@indices, $i));
 767     return undef unless (defined($new_text));
 768     $new_contents .= $start_tag . $new_text . $end_tag;
 769   }
 770   map({ delete($form->{"__${_}__"}); } qw(first last odd counter));
 771
 772   return $new_contents;
 773 }
 774
 775 sub find_end {
 776   my ($self, $text, $pos, $var, $not) = @_;
 777
 778   my $depth = 1;
 779   $pos = 0 unless ($pos);
 780
 781   while ($pos < length($text)) {
 782     $pos++;
 783
 784     next if (substr($text, $pos - 1, 5) ne '&lt;%');
 785
 786     if ((substr($text, $pos + 4, 2) eq 'if') || (substr($text, $pos + 4, 3) eq 'for')) {
 787       $depth++;
 788
 789     } elsif ((substr($text, $pos + 4, 4) eq 'else') && (1 == $depth)) {
 790       if (!$var) {
 791         $self->{"error"} = '<%else%> outside of <%if%> / <%ifnot%>.';
 792         return undef;
 793       }
 794
 795       my $block = substr($text, 0, $pos - 1);
 796       substr($text, 0, $pos - 1) = "";
 797       $text =~ s!^\&lt;\%[^\%]+\%\&gt;!!;
 798       $text = '&lt;%if' . ($not ?  " " : "not ") . $var . '%&gt;' . $text;
 799
 800       return ($block, $text);
 801
 802     } elsif (substr($text, $pos + 4, 3) eq 'end') {
 803       $depth--;
 804       if ($depth == 0) {
 805         my $block = substr($text, 0, $pos - 1);
 806         substr($text, 0, $pos - 1) = "";
 807         $text =~ s!^\&lt;\%[^\%]+\%\&gt;!!;
 808
 809         return ($block, $text);
 810       }
 811     }
 812   }
 813
 814   return undef;
 815 }
 816
 817 sub parse_block {
 818   $main::lxdebug->enter_sub();
 819
 820   my ($self, $contents, @indices) = @_;
 821
 822   my $new_contents = "";
 823
 824   while ($contents ne "") {
 825     if (substr($contents, 0, 1) eq "<") {
 826       $contents =~ m|^<[^>]+>|;
 827       my $tag = $&;
 828       substr($contents, 0, length($&)) = "";
 829
 830       if ($tag =~ m|<table:table-row|) {
 831         $contents =~ m|^(.*?)(</table:table-row[^>]*>)|;
 832         my $table_row = $1;
 833         my $end_tag = $2;
 834         substr($contents, 0, length($1) + length($end_tag)) = "";
 835
 836         if ($table_row =~ m|\&lt;\%foreachrow\s+(.*?)\%\&gt;|) {
 837           my $var = $1;
 838
 839           substr($table_row, length($`), length($&)) = "";
 840
 841           my ($t1, $t2) = $self->find_end($table_row, length($`));
 842           if (!$t1) {
 843             $self->{"error"} = "Unclosed <\%foreachrow\%>." unless ($self->{"error"});
 844             $main::lxdebug->leave_sub();
 845             return undef;
 846           }
 847
 848           my $new_text = $self->parse_foreach($var, $t1 . $t2, $tag, $end_tag, @indices);
 849           if (!defined($new_text)) {
 850             $main::lxdebug->leave_sub();
 851             return undef;
 852           }
 853           $new_contents .= $new_text;
 854
 855         } else {
 856           my $new_text = $self->parse_block($table_row, @indices);
 857           if (!defined($new_text)) {
 858             $main::lxdebug->leave_sub();
 859             return undef;
 860           }
 861           $new_contents .= $tag . $new_text . $end_tag;
 862         }
 863
 864       } else {
 865         $new_contents .= $tag;
 866       }
 867
 868     } else {
 869       $contents =~ /^[^<]+/;
 870       my $text = $&;
 871
 872       my $pos_if = index($text, '&lt;%if');
 873       my $pos_foreach = index($text, '&lt;%foreach');
 874
 875       if ((-1 == $pos_if) && (-1 == $pos_foreach)) {
 876         substr($contents, 0, length($text)) = "";
 877         $new_contents .= $self->substitute_vars($text, @indices);
 878         next;
 879       }
 880
 881       if ((-1 == $pos_if) || ((-1 != $pos_foreach) && ($pos_if > $pos_foreach))) {
 882         $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_foreach), @indices);
 883         substr($contents, 0, $pos_foreach) = "";
 884
 885         if ($contents !~ m|^\&lt;\%foreach (.*?)\%\&gt;|) {
 886           $self->{"error"} = "Malformed <\%foreach\%>.";
 887           $main::lxdebug->leave_sub();
 888           return undef;
 889         }
 890
 891         my $var = $1;
 892
 893         substr($contents, 0, length($&)) = "";
 894
 895         my $block;
 896         ($block, $contents) = $self->find_end($contents);
 897         if (!$block) {
 898           $self->{"error"} = "Unclosed <\%foreach\%>." unless ($self->{"error"});
 899           $main::lxdebug->leave_sub();
 900           return undef;
 901         }
 902
 903         my $new_text = $self->parse_foreach($var, $block, "", "", @indices);
 904         if (!defined($new_text)) {
 905           $main::lxdebug->leave_sub();
 906           return undef;
 907         }
 908         $new_contents .= $new_text;
 909
 910       } else {
 911         $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_if), @indices);
 912         substr($contents, 0, $pos_if) = "";
 913
 914         if ($contents !~ m|^\&lt;\%if\s*(not)?\s+(.*?)\%\&gt;|) {
 915           $self->{"error"} = "Malformed <\%if\%>.";
 916           $main::lxdebug->leave_sub();
 917           return undef;
 918         }
 919
 920         my ($not, $var) = ($1, $2);
 921
 922         substr($contents, 0, length($&)) = "";
 923
 924         ($block, $contents) = $self->find_end($contents, 0, $var, $not);
 925         if (!$block) {
 926           $self->{"error"} = "Unclosed <\%if${not}\%>." unless ($self->{"error"});
 927           $main::lxdebug->leave_sub();
 928           return undef;
 929         }
 930
 931         my $value = $self->{"form"}->{$var};
 932         for (my $i = 0; $i < scalar(@indices); $i++) {
 933           last unless (ref($value) eq "ARRAY");
 934           $value = $value->[$indices[$i]];
 935         }
 936
 937         if (($not && !$value) || (!$not && $value)) {
 938           my $new_text = $self->parse_block($block, @indices);
 939           if (!defined($new_text)) {
 940             $main::lxdebug->leave_sub();
 941             return undef;
 942           }
 943           $new_contents .= $new_text;
 944         }
 945       }
 946     }
 947   }
 948
 949   $main::lxdebug->leave_sub();
 950
 951   return $new_contents;
 952 }
 953
 954 sub parse {
 955   $main::lxdebug->enter_sub();
 956
 957   my $self = $_[0];
 958   local *OUT = $_[1];
 959   my $form = $self->{"form"};
 960
 961   close(OUT);
 962
 963   my $file_name;
 964   if ($form->{"IN"} =~ m|^/|) {
 965     $file_name = $form->{"IN"};
 966   } else {
 967     $file_name = $form->{"templates"} . "/" . $form->{"IN"};
 968   }
 969
 970   my $zip = Archive::Zip->new();
 971   if (Archive::Zip::AZ_OK != $zip->read($file_name)) {
 972     $self->{"error"} = "File not found/is not a OpenDocument file.";
 973     $main::lxdebug->leave_sub();
 974     return 0;
 975   }
 976
 977   my $contents = $zip->contents("content.xml");
 978   if (!$contents) {
 979     $self->{"error"} = "File is not a OpenDocument file.";
 980     $main::lxdebug->leave_sub();
 981     return 0;
 982   }
 983
 984   my $rnd = $self->{"rnd"};
 985   my $new_styles = qq|<style:style style:name="TLXO${rnd}BOLD" style:family="text">
 986 <style:text-properties fo:font-weight="bold" style:font-weight-asian="bold" style:font-weight-complex="bold"/>
 987 </style:style>
 988 <style:style style:name="TLXO${rnd}ITALIC" style:family="text">
 989 <style:text-properties fo:font-style="italic" style:font-style-asian="italic" style:font-style-complex="italic"/>
 990 </style:style>
 991 <style:style style:name="TLXO${rnd}UNDERLINE" style:family="text">
 992 <style:text-properties style:text-underline-style="solid" style:text-underline-width="auto" style:text-underline-color="font-color"/>
 993 </style:style>
 994 <style:style style:name="TLXO${rnd}STRIKETHROUGH" style:family="text">
 995 <style:text-properties style:text-line-through-style="solid"/>
 996 </style:style>
 997 <style:style style:name="TLXO${rnd}SUPER" style:family="text">
 998 <style:text-properties style:text-position="super 58%"/>
 999 </style:style>
1000 <style:style style:name="TLXO${rnd}SUB" style:family="text">
1001 <style:text-properties style:text-position="sub 58%"/>
1002 </style:style>
1003 |;
1004
1005   $contents =~ s|</office:automatic-styles>|${new_styles}</office:automatic-styles>|;
1006   $contents =~ s|[\n\r]||gm;
1007
1008   my $new_contents = $self->parse_block($contents);
1009   if (!defined($new_contents)) {
1010     $main::lxdebug->leave_sub();
1011     return 0;
1012   }
1013
1014 #   $new_contents =~ s|>|>\n|g;
1015
1016   $zip->contents("content.xml", $new_contents);
1017
1018   my $styles = $zip->contents("styles.xml");
1019   if ($contents) {
1020     my $new_styles = $self->parse_block($styles);
1021     if (!defined($new_contents)) {
1022       $main::lxdebug->leave_sub();
1023       return 0;
1024     }
1025     $zip->contents("styles.xml", $new_styles);
1026   }
1027
1028   $zip->writeToFileNamed($form->{"tmpfile"}, 1);
1029
1030   my $res = 1;
1031   if ($form->{"format"} =~ /pdf/) {
1032     $res = $self->convert_to_pdf();
1033   }
1034
1035   $main::lxdebug->leave_sub();
1036   return $res;
1037 }
1038
1039 sub is_xvfb_running {
1040   $main::lxdebug->enter_sub();
1041
1042   my ($self) = @_;
1043
1044   local *IN;
1045   my $dfname = $self->{"userspath"} . "/xvfb_display";
1046   my $display;
1047
1048   $main::lxdebug->message(LXDebug::DEBUG2, "    Looking for $dfname\n");
1049   if ((-f $dfname) && open(IN, $dfname)) {
1050     my $pid = <IN>;
1051     chomp($pid);
1052     $display = <IN>;
1053     chomp($display);
1054     my $xauthority = <IN>;
1055     chomp($xauthority);
1056     close(IN);
1057
1058     $main::lxdebug->message(LXDebug::DEBUG2, "      found with $pid and $display\n");
1059
1060     if ((! -d "/proc/$pid") || !open(IN, "/proc/$pid/cmdline")) {
1061       $main::lxdebug->message(LXDebug::DEBUG2, "  no/wrong process #1\n");
1062       unlink($dfname, $xauthority);
1063       $main::lxdebug->leave_sub();
1064       return undef;
1065     }
1066     my $line = <IN>;
1067     close(IN);
1068     if ($line !~ /xvfb/i) {
1069       $main::lxdebug->message(LXDebug::DEBUG2, "      no/wrong process #2\n");
1070       unlink($dfname, $xauthority);
1071       $main::lxdebug->leave_sub();
1072       return undef;
1073     }
1074
1075     $ENV{"XAUTHORITY"} = $xauthority;
1076     $ENV{"DISPLAY"} = $display;
1077   } else {
1078     $main::lxdebug->message(LXDebug::DEBUG2, "      not found\n");
1079   }
1080
1081   $main::lxdebug->leave_sub();
1082
1083   return $display;
1084 }
1085
1086 sub spawn_xvfb {
1087   $main::lxdebug->enter_sub();
1088
1089   my ($self) = @_;
1090
1091   $main::lxdebug->message(LXDebug::DEBUG2, "spawn_xvfb()\n");
1092
1093   my $display = $self->is_xvfb_running();
1094
1095   if ($display) {
1096     $main::lxdebug->leave_sub();
1097     return $display;
1098   }
1099
1100   $display = 99;
1101   while ( -f "/tmp/.X${display}-lock") {
1102     $display++;
1103   }
1104   $display = ":${display}";
1105   $main::lxdebug->message(LXDebug::DEBUG2, "  display $display\n");
1106
1107   my $mcookie = `mcookie`;
1108   die("Installation error: mcookie not found.") if ($? != 0);
1109   chomp($mcookie);
1110
1111   $main::lxdebug->message(LXDebug::DEBUG2, "  mcookie $mcookie\n");
1112
1113   my $xauthority = "/tmp/.Xauthority-" . $$ . "-" . time() . "-" . int(rand(9999999));
1114   $ENV{"XAUTHORITY"} = $xauthority;
1115
1116   $main::lxdebug->message(LXDebug::DEBUG2, "  xauthority $xauthority\n");
1117
1118   system("xauth add \"${display}\" . \"${mcookie}\"");
1119   if ($? != 0) {
1120     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started (xauth: $!)";
1121     $main::lxdebug->leave_sub();
1122     return undef;
1123   }
1124
1125   $main::lxdebug->message(LXDebug::DEBUG2, "  about to fork()\n");
1126
1127   my $pid = fork();
1128   if (0 == $pid) {
1129     $main::lxdebug->message(LXDebug::DEBUG2, "  Child execing\n");
1130     exec($main::xvfb_bin, $display, "-screen", "0", "640x480x8", "-nolisten", "tcp");
1131   }
1132   sleep(3);
1133   $main::lxdebug->message(LXDebug::DEBUG2, "  parent dont sleeping\n");
1134
1135   local *OUT;
1136   my $dfname = $self->{"userspath"} . "/xvfb_display";
1137   if (!open(OUT, ">$dfname")) {
1138     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started ($dfname: $!)";
1139     unlink($xauthority);
1140     kill($pid);
1141     $main::lxdebug->leave_sub();
1142     return undef;
1143   }
1144   print(OUT "$pid\n$display\n$xauthority\n");
1145   close(OUT);
1146
1147   $main::lxdebug->message(LXDebug::DEBUG2, "  parent re-testing\n");
1148
1149   if (!$self->is_xvfb_running()) {
1150     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started.";
1151     unlink($xauthority, $dfname);
1152     kill($pid);
1153     $main::lxdebug->leave_sub();
1154     return undef;
1155   }
1156
1157   $main::lxdebug->message(LXDebug::DEBUG2, "  spawn OK\n");
1158
1159   $main::lxdebug->leave_sub();
1160
1161   return $display;
1162 }
1163
1164 sub is_openoffice_running {
1165   $main::lxdebug->enter_sub();
1166
1167   system("./scripts/oo-uno-test-conn.py $main::openofficeorg_daemon_port " .
1168          "> /dev/null 2> /dev/null");
1169   my $res = $? == 0;
1170   $main::lxdebug->message(LXDebug::DEBUG2, "  is_openoffice_running(): $?\n");
1171
1172   $main::lxdebug->leave_sub();
1173
1174   return $res;
1175 }
1176
1177 sub spawn_openoffice {
1178   $main::lxdebug->enter_sub();
1179
1180   my ($self) = @_;
1181
1182   $main::lxdebug->message(LXDebug::DEBUG2, "spawn_openoffice()\n");
1183
1184   my ($try, $spawned_oo, $res);
1185
1186   $res = 0;
1187   for ($try = 0; $try < 15; $try++) {
1188     if ($self->is_openoffice_running()) {
1189       $res = 1;
1190       last;
1191     }
1192
1193     if (!$spawned_oo) {
1194       my $pid = fork();
1195       if (0 == $pid) {
1196         $main::lxdebug->message(LXDebug::DEBUG2, "  Child daemonizing\n");
1197         chdir('/');
1198         open(STDIN, '/dev/null');
1199         open(STDOUT, '>/dev/null');
1200         my $new_pid = fork();
1201         exit if ($new_pid);
1202         my $ssres = setsid();
1203         $main::lxdebug->message(LXDebug::DEBUG2, "  Child execing\n");
1204         my @cmdline = ($main::openofficeorg_writer_bin,
1205                        "-minimized", "-norestore", "-nologo", "-nolockcheck",
1206                        "-headless",
1207                        "-accept=socket,host=localhost,port=" .
1208                        $main::openofficeorg_daemon_port . ";urp;");
1209         exec(@cmdline);
1210       }
1211
1212       $main::lxdebug->message(LXDebug::DEBUG2, "  Parent after fork\n");
1213       $spawned_oo = 1;
1214       sleep(3);
1215     }
1216
1217     sleep($try >= 5 ? 2 : 1);
1218   }
1219
1220   if (!$res) {
1221     $self->{"error"} = "Conversion from OpenDocument to PDF failed because " .
1222       "OpenOffice could not be started.";
1223   }
1224
1225   $main::lxdebug->leave_sub();
1226
1227   return $res;
1228 }
1229
1230 sub convert_to_pdf {
1231   $main::lxdebug->enter_sub();
1232
1233   my ($self) = @_;
1234
1235   my $form = $self->{"form"};
1236
1237   my $filename = $form->{"tmpfile"};
1238   $filename =~ s/.odt$//;
1239   if (substr($filename, 0, 1) ne "/") {
1240     $filename = getcwd() . "/${filename}";
1241   }
1242
1243   if (substr($self->{"userspath"}, 0, 1) eq "/") {
1244     $ENV{'HOME'} = $self->{"userspath"};
1245   } else {
1246     $ENV{'HOME'} = getcwd() . "/" . $self->{"userspath"};
1247   }
1248
1249   if (!$self->spawn_xvfb()) {
1250     $main::lxdebug->leave_sub();
1251     return 0;
1252   }
1253
1254   my @cmdline;
1255   if (!$main::openofficeorg_daemon) {
1256     @cmdline = ($main::openofficeorg_writer_bin,
1257                 "-minimized", "-norestore", "-nologo", "-nolockcheck",
1258                 "-headless",
1259                 "file:${filename}.odt",
1260                 "macro://" . (split('/', $filename))[-1] .
1261                 "/Standard.Conversion.ConvertSelfToPDF()");
1262   } else {
1263     if (!$self->spawn_openoffice()) {
1264       $main::lxdebug->leave_sub();
1265       return 0;
1266     }
1267
1268     @cmdline = ("./scripts/oo-uno-convert-pdf.py",
1269                 $main::openofficeorg_daemon_port,
1270                 "${filename}.odt");
1271   }
1272
1273   system(@cmdline);
1274
1275   my $res = $?;
1276   if (0 == $?) {
1277     $form->{"tmpfile"} =~ s/odt$/pdf/;
1278
1279     unlink($filename . ".odt");
1280
1281     $main::lxdebug->leave_sub();
1282     return 1;
1283
1284   }
1285
1286   unlink($filename . ".odt", $filename . ".pdf");
1287   $self->{"error"} = "Conversion from OpenDocument to PDF failed. " .
1288     "Exit code: $res";
1289
1290   $main::lxdebug->leave_sub();
1291   return 0;
1292 }
1293
1294 sub format_string {
1295   my ($self, $variable) = @_;
1296   my $form = $self->{"form"};
1297   my $iconv = $self->{"iconv"};
1298
1299   my %replace =
1300     ('order' => ['&', '<', '>', '"', "'",
1301                  '\x80',        # Euro
1302                  quotemeta("\n"), quotemeta("\r")],
1303      '<'             => '&lt;',
1304      '>'             => '&gt;',
1305      '"'             => '&quot;',
1306      "'"             => '&apos;',
1307      '&'             => '&amp;',
1308      '\x80'          => chr(0xa4), # Euro
1309      quotemeta("\n") => '<text:line-break/>',
1310      quotemeta("\r") => '',
1311      );
1312
1313   map({ $variable =~ s/$_/$replace{$_}/g; } @{ $replace{"order"} });
1314
1315   # Allow some HTML markup to be converted into the output format's
1316   # corresponding markup code, e.g. bold or italic.
1317   my $rnd = $self->{"rnd"};
1318   my %markup_replace = ("b" => "BOLD", "i" => "ITALIC", "s" => "STRIKETHROUGH",
1319                         "u" => "UNDERLINE", "sup" => "SUPER", "sub" => "SUB");
1320
1321   foreach my $key (keys(%markup_replace)) {
1322     my $value = $markup_replace{$key};
1323     $variable =~ s|\&lt;${key}\&gt;|<text:span text:style-name=\"TLXO${rnd}${value}\">|gi;
1324     $variable =~ s|\&lt;/${key}\&gt;|</text:span>|gi;
1325   }
1326
1327   return $iconv->convert($variable);
1328 }
1329
1330 sub get_mime_type() {
1331   if ($self->{"form"}->{"format"} =~ /pdf/) {
1332     return "application/pdf";
1333   } else {
1334     return "application/vnd.oasis.opendocument.text";
1335   }
1336 }
1337
1338 sub uses_temp_file {
1339   return 1;
1340 }
1341
1342
1343 ##########################################################
1344 ####
1345 #### XMLTemplate
1346 ####
1347 ##########################################################
1348
1349 package XMLTemplate;
1350
1351 use vars qw(@ISA);
1352
1353 @ISA = qw(HTMLTemplate);
1354
1355 sub new {
1356   #evtl auskommentieren
1357   my $type = shift;
1358
1359   return $type->SUPER::new(@_);
1360 }
1361
1362 sub format_string {
1363   my ($self, $variable) = @_;
1364   my $form = $self->{"form"};
1365
1366   my %replace =
1367     ('order' => ['<', '>', quotemeta("\n")],
1368      '<'             => '&lt;',
1369      '>'             => '&gt;',
1370      quotemeta("\n") => '<br>',
1371      );
1372
1373   map({ $variable =~ s/$_/$replace{$_}/g; } @{ $replace{"order"} });
1374
1375   # Allow no markup to be converted into the output format
1376   my @markup_replace = ('b', 'i', 's', 'u', 'sub', 'sup');
1377
1378   foreach my $key (@markup_replace) {
1379     $variable =~ s/\&lt;(\/?)${key}\&gt;//g;
1380   }
1381
1382   return $variable;
1383 }
1384
1385 sub get_mime_type() {
1386   my ($self) = @_;
1387
1388   if ($self->{"form"}->{"format"} =~ /elsterwinston/i) {
1389     return "application/xml ";
1390   } elsif ($self->{"form"}->{"format"} =~ /elstertaxbird/i) {
1391     return "application/x-taxbird";
1392   } else {
1393     return "text";
1394   }
1395 }
1396
1397 sub uses_temp_file {
1398   # tempfile needet for XML Output
1399   return 1;
1400 }
1401
1402 1;