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