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