SL/Template.pm

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