SL/Template.pm

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